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

2004-03-09 13:50 UTC+0100 Ryszard Glab <rglab@imid.med.pl>

Browse Source 
+ source/rtl/altd.prg
      +new file with ALTD() procedure code

   * hrbdll.bc
   * hrbdll.vc
   * makefile.bc
   * makefile.nt
   * makefile.vc
   * source/rtl/Makefile
      *added a reference to rtl/altd.prg

   * source/common/hbffind.c
      *fixed to compile correctly with HB_OS_UNIX

   * include/hbcomp.h
   * include/hbexpra.c
   * include/hbexprb.c
   * include/hbexprop.h
   * include/hbpcode.h
   * source/common/expropt1.c
   * source/compiler/expropta.c
   * source/compiler/exproptb.c
   * source/compiler/genc.c
   * source/compiler/harbour.c
   * source/compiler/harbour.y
   * source/compiler/hbfix.c
   * source/compiler/hbgenerr.c
   * source/compiler/hbpcode.c
   * source/macro/macro.y
   * source/macro/macroa.c
   * source/macro/macrob.c
   * source/vm/hvm.c
      +added missing support for @&macro and @M->memvar
      +added new pcode HB_MACROPUSHREF (all sources have to be
       recompiled)

   * source/debug/dbgtwin.prg
   * source/debug/debugger.prg
      *fixed procedures callstack when modules with/without debug info
      are linked together
      *fixed the debugger activation when ALTD() is used in
      a module with no debug info (the debugger shows up
      on the first line with debug info after the ALTD()
      is called)

   NOTICE:
      Some compilers may require that the debug library has to
      be specified as an object file in order to get the
      debugger linked in.
This commit is contained in:
Ryszard Glab
2004-03-09 13:51:50 +00:00
parent 35d723904d
commit 0fcf861638
29 changed files with 464 additions and 106 deletions
Download Patch File Download Diff File Expand all files Collapse all files

51
harbour/ChangeLog
View File

@@ -8,6 +8,57 @@
2002-12-01 23:12 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
2004-03-09 13:50 UTC+0100 Ryszard Glab <rglab@imid.med.pl>
+ source/rtl/altd.prg
+new file with ALTD() procedure code
* hrbdll.bc
* hrbdll.vc
* makefile.bc
* makefile.nt
* makefile.vc
* source/rtl/Makefile
*added a reference to rtl/altd.prg
* source/common/hbffind.c
*fixed to compile correctly with HB_OS_UNIX
* include/hbcomp.h
* include/hbexpra.c
* include/hbexprb.c
* include/hbexprop.h
* include/hbpcode.h
* source/common/expropt1.c
* source/compiler/expropta.c
* source/compiler/exproptb.c
* source/compiler/genc.c
* source/compiler/harbour.c
* source/compiler/harbour.y
* source/compiler/hbfix.c
* source/compiler/hbgenerr.c
* source/compiler/hbpcode.c
* source/macro/macro.y
* source/macro/macroa.c
* source/macro/macrob.c
* source/vm/hvm.c
+added missing support for @&macro and @M->memvar
+added new pcode HB_MACROPUSHREF (all sources have to be
recompiled)
* source/debug/dbgtwin.prg
* source/debug/debugger.prg
*fixed procedures callstack when modules with/without debug info
are linked together
*fixed the debugger activation when ALTD() is used in
a module with no debug info (the debugger shows up
on the first line with debug info after the ALTD()
is called)
NOTICE:
Some compilers may require that the debug library has to
be specified as an object file in order to get the
debugger linked in.
2004-03-08 19:50 UTC+0300 Alexander Kresin <alex@belacy.belgorod.su>
+ ChangeLog

8
harbour/hrbdll.bc
View File

@@ -100,6 +100,7 @@ HARBOUR_DLL_OBJS = \
$(OBJ_DIR)\achoice.obj \
$(OBJ_DIR)\adir.obj \
$(OBJ_DIR)\alert.obj \
$(OBJ_DIR)\altd.obj \
$(OBJ_DIR)\ampm.obj \
$(OBJ_DIR)\at.obj \
$(OBJ_DIR)\binnum.obj \
@@ -662,6 +663,7 @@ $(HARBOUR_DLL) : \
echo. $(OBJ_DIR)\achoice.obj + >> hdll.tmp
echo. $(OBJ_DIR)\adir.obj + >> hdll.tmp
echo. $(OBJ_DIR)\alert.obj + >> hdll.tmp
echo. $(OBJ_DIR)\altd.obj + >> hdll.tmp
echo. $(OBJ_DIR)\ampm.obj + >> hdll.tmp
echo. $(OBJ_DIR)\at.obj + >> hdll.tmp
echo. $(OBJ_DIR)\binnum.obj + >> hdll.tmp
@@ -1438,6 +1440,12 @@ $(OBJ_DIR)\alert.c : $(RTL_DIR)\alert.prg
$(OBJ_DIR)\alert.obj : $(OBJ_DIR)\alert.c
$(CC) $(CLIBFLAGS) -o$@ $**
$(OBJ_DIR)\altd.c : $(RTL_DIR)\altd.prg
$(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@
$(OBJ_DIR)\altd.obj : $(OBJ_DIR)\altd.c
$(CC) $(CLIBFLAGS) -o$@ $**
$(OBJ_DIR)\ampm.obj : $(RTL_DIR)\ampm.c
$(CC) $(CLIBFLAGS) -o$@ $**

8
harbour/hrbdll.vc
View File

@@ -214,6 +214,7 @@ HARBOUR_DLL_OBJS = \
$(OBJ_DIR)\achoice.obj \
$(OBJ_DIR)\adir.obj \
$(OBJ_DIR)\alert.obj \
$(OBJ_DIR)\altd.obj \
$(OBJ_DIR)\browdb.obj \
$(OBJ_DIR)\browdbx.obj \
$(OBJ_DIR)\browse.obj \
@@ -355,6 +356,7 @@ HARBOUR_DLL_OBJS = \
$(OBJ_DIR)\dbgtmitm.obj \
$(OBJ_DIR)\dbgtwin.obj \
$(OBJ_DIR)\debugger.obj \
$(OBJ_DIR)\dbgbrwsr.obj \
$(OBJ_DIR)\dbgtarr.obj \
$(OBJ_DIR)\dbgtobj.obj \
$(OBJ_DIR)\tbrwtext.obj \
@@ -836,6 +838,12 @@ $(OBJ_DIR)\alert.c : $(RTL_DIR)\alert.prg
$(OBJ_DIR)\alert.obj : $(OBJ_DIR)\alert.c
$(CC) $(CLIBFLAGS) /Fo$@ $**
$(OBJ_DIR)\altd.c : $(RTL_DIR)\altd.prg
$(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@
$(OBJ_DIR)\altd.obj : $(OBJ_DIR)\altd.c
$(CC) $(CLIBFLAGS) /Fo$@ $**
$(OBJ_DIR)\ampm.obj : $(RTL_DIR)\ampm.c
$(CC) $(CLIBFLAGS) /Fo$@ $**

3
harbour/include/hbcomp.h
View File

@@ -328,6 +328,7 @@ extern void hb_compAutoOpenAdd( char * szName );
#define hb_compErrorBound( p ) hb_macroError( EG_BOUND, HB_MACRO_PARAM )
#define hb_compErrorAlias( p ) hb_macroError( EG_NOALIAS, HB_MACRO_PARAM )
#define hb_compErrorDuplVar( c ) hb_macroError( EG_SYNTAX, HB_MACRO_PARAM )
#define hb_compErrorRefer( p,c ) hb_macroError( EG_SYNTAX, HB_MACRO_PARAM )
#define hb_compWarnMeaningless( p )
#define hb_compErrorMacro( p )
@@ -362,6 +363,7 @@ extern void hb_compGenPushSymbol( char * szSymbolName, BOOL bFunction, BOOL bAli
extern void hb_compGenPushAliasedVar( char *, BOOL, char *, long );
extern void hb_compGenPopAliasedVar( char *, BOOL, char *, long );
extern void hb_compGenPushFunRef( char * );
extern void hb_compGenVarPCode( BYTE, char * );
extern void hb_compGenPCode1( BYTE ); /* generates 1 byte of pcode */
extern void hb_compGenPData1( BYTE ); /* generates 1 byte of pcode argument */
extern void hb_compGenPCode2( BYTE, BYTE, BOOL ); /* generates 2 bytes of pcode + flag for optional StrongType(). */
@@ -398,6 +400,7 @@ extern void hb_compErrorDuplVar( char * );
extern HB_EXPR_PTR hb_compWarnMeaningless( HB_EXPR_PTR );
extern void hb_compErrorCodeblock( char * );
extern void hb_compErrorMacro( char * );
extern HB_EXPR_PTR hb_compErrorRefer( HB_EXPR_PTR, char * );
extern void hb_compChkCompilerSwitch( int, char * Args[] );
extern void hb_compChkEnvironVar( char * );

1
harbour/include/hbexpra.c
View File

@@ -83,6 +83,7 @@ static BYTE s_PrecedTable[] = {
HB_ET_NIL, /* HB_ET_SELF, */
HB_ET_NIL, /* HB_ET_ARRAY, */
HB_ET_NIL, /* HB_ET_VARREF, */
HB_ET_NIL, /* HB_ET_REFERENCE, */
HB_ET_NIL, /* HB_ET_FUNREF, */
HB_ET_NIL, /* HB_ET_IIF, */
HB_ET_NIL, /* HB_ET_LIST, */

84
harbour/include/hbexprb.c
View File

@@ -127,6 +127,7 @@ static HB_EXPR_FUNC( hb_compExprUseLogical );
static HB_EXPR_FUNC( hb_compExprUseSelf );
static HB_EXPR_FUNC( hb_compExprUseArray );
static HB_EXPR_FUNC( hb_compExprUseVarRef );
static HB_EXPR_FUNC( hb_compExprUseRef );
static HB_EXPR_FUNC( hb_compExprUseFunRef );
static HB_EXPR_FUNC( hb_compExprUseIIF );
static HB_EXPR_FUNC( hb_compExprUseList );
@@ -192,6 +193,7 @@ HB_EXPR_FUNC_PTR hb_comp_ExprTable[] = {
hb_compExprUseSelf,
hb_compExprUseArray,
hb_compExprUseVarRef,
hb_compExprUseRef,
hb_compExprUseFunRef,
hb_compExprUseIIF,
hb_compExprUseList,
@@ -805,6 +807,81 @@ static HB_EXPR_FUNC( hb_compExprUseFunRef )
return pSelf;
}
/* actions for HB_ET_REFERENCE expression
*/
static HB_EXPR_FUNC( hb_compExprUseRef )
{
switch( iMessage )
{
case HB_EA_REDUCE:
break;
case HB_EA_ARRAY_AT:
hb_compErrorType( pSelf );
break;
case HB_EA_ARRAY_INDEX:
break;
case HB_EA_LVALUE:
hb_compErrorLValue( pSelf );
break;
case HB_EA_PUSH_PCODE:
{
HB_EXPR_PTR pExp = pSelf->value.asReference;
if( pExp->ExprType == HB_ET_MACRO )
{
pExp->value.asMacro.SubType = HB_ET_MACRO_REFER;
HB_EXPR_USE( pExp, HB_EA_PUSH_PCODE );
}
else if( pExp->ExprType == HB_ET_ALIASVAR )
{
char *szAlias = pExp->value.asAlias.pAlias->value.asSymbol;
if( szAlias[ 0 ] == 'M' && szAlias[ 1 ] == '\0' )
{ /* @M->variable */
if( pExp->value.asAlias.pVar->ExprType == HB_ET_VARIABLE )
{
#if !defined(HB_MACRO_SUPPORT)
HB_EXPR_PCODE2( hb_compGenVarPCode, HB_P_PUSHMEMVARREF, pExp->value.asAlias.pVar->value.asSymbol );
#else
HB_EXPR_PCODE2( hb_compMemvarGenPCode, HB_P_MPUSHMEMVARREF, pExp->value.asAlias.pVar->value.asSymbol );
#endif
}
else /* @M->&l, @M->&l.1, @&m->l, etc. */
hb_compErrorRefer( pSelf, szAlias );
}
else
{
int iCmp = strncmp( szAlias, "MEMVAR", 4 );
if( iCmp == 0 )
iCmp = strncmp( szAlias, "MEMVAR", strlen( szAlias ) );
if( iCmp == 0 && pExp->value.asAlias.pVar->ExprType == HB_ET_VARIABLE )
{ /* @MEMVAR-> or @MEMVA-> or @MEMV-> */
#if !defined(HB_MACRO_SUPPORT)
HB_EXPR_PCODE2( hb_compGenVarPCode, HB_P_PUSHMEMVARREF, pExp->value.asAlias.pVar->value.asSymbol );
#else
HB_EXPR_PCODE2( hb_compMemvarGenPCode, HB_P_MPUSHMEMVARREF, pExp->value.asAlias.pVar->value.asSymbol );
#endif
}
else
hb_compErrorRefer( pSelf, szAlias );
}
}
else
hb_compErrorRefer( pSelf, hb_compExprDescription(pSelf) );
}
break;
case HB_EA_POP_PCODE:
break;
case HB_EA_PUSH_POP:
case HB_EA_STATEMENT:
hb_compWarnMeaningless( pSelf );
case HB_EA_DELETE:
HB_EXPR_PCODE1( hb_compExprDelete, pSelf->value.asReference );
break;
}
return pSelf;
}
/* actions for HB_ET_IIF expression
*/
static HB_EXPR_FUNC( hb_compExprUseIIF )
@@ -1227,6 +1304,9 @@ static HB_EXPR_FUNC( hb_compExprUseMacro )
if( pSelf->value.asMacro.SubType == HB_ET_MACRO_SYMBOL )
HB_EXPR_GENPCODE1( hb_compGenPCode1, HB_P_MACROSYMBOL );
else if( pSelf->value.asMacro.SubType == HB_ET_MACRO_REFER )
HB_EXPR_GENPCODE1( hb_compGenPCode1, HB_P_MACROPUSHREF );
else if( pSelf->value.asMacro.SubType != HB_ET_MACRO_ALIASED )
{
if( HB_COMP_ISSUPPORTED(HB_COMPFLAG_XBASE) )
@@ -1284,7 +1364,9 @@ static HB_EXPR_FUNC( hb_compExprUseMacro )
}
if( ( pSelf->value.asMacro.SubType != HB_ET_MACRO_SYMBOL ) &&
( pSelf->value.asMacro.SubType != HB_ET_MACRO_ALIASED && ! ( pSelf->value.asMacro.SubType & HB_ET_MACRO_ARGLIST ) ) )
( pSelf->value.asMacro.SubType != HB_ET_MACRO_REFER ) &&
( pSelf->value.asMacro.SubType != HB_ET_MACRO_ALIASED &&
! ( pSelf->value.asMacro.SubType & HB_ET_MACRO_ARGLIST ) ) )
{
/* Always add add byte to pcode indicating requested macro compiler flag. */
#if defined( HB_MACRO_SUPPORT )

8
harbour/include/hbexprop.h
View File

@@ -103,6 +103,7 @@ typedef enum
#define HB_ET_MACRO_LIST 16 /* &variable used as in literal arrays or parentesised expressions. */
#define HB_ET_MACRO_INDEX 32 /* &variable used as arrays index. */
#define HB_ET_MACRO_PARE 64 /* &variable used as arrays index. */
#define HB_ET_MACRO_REFER 128 /* &macro used in @ (pass by reference) */
/* types of expressions
* NOTE: the order of these definition is important - change it carefully
@@ -121,6 +122,7 @@ typedef enum
HB_ET_SELF,
HB_ET_ARRAY,
HB_ET_VARREF,
HB_ET_REFERENCE,
HB_ET_FUNREF,
HB_ET_IIF,
HB_ET_LIST,
@@ -207,8 +209,8 @@ typedef struct HB_EXPR_
struct
{
BOOL isMacro; /* TRUE=codeblock contains macro expression */
BOOL lateEval; /* TRUE=late evaluation of macro */
char *string; /* source code of a codeblock */
BOOL lateEval; /* TRUE=late evaluation of macro */
char *string; /* source code of a codeblock */
struct HB_EXPR_ *pExprList; /* list elements */
HB_CBVAR_PTR pLocals; /* list of local variables */
} asCodeblock;
@@ -234,6 +236,7 @@ typedef struct HB_EXPR_
struct HB_EXPR_ *pLeft; /* object */
struct HB_EXPR_ *pRight; /* object */
} asOperator;
struct HB_EXPR_ *asReference;
} value;
ULONG ulLength;
ULONG Counter;
@@ -349,6 +352,7 @@ HB_EXPR_PTR hb_compExprNewNot( HB_EXPR_PTR );
HB_EXPR_PTR hb_compExprNewNegate( HB_EXPR_PTR );
HB_EXPR_PTR hb_compExprNewVarRef( char * );
HB_EXPR_PTR hb_compExprNewFunRef( char * );
HB_EXPR_PTR hb_compExprNewRef( HB_EXPR_PTR );
HB_EXPR_PTR hb_compExprNewCodeblockExpr( HB_EXPR_PTR, HB_EXPR_PTR );
HB_EXPR_PTR hb_compExprNewFunCallArg( HB_EXPR_PTR, HB_EXPR_PTR );
HB_EXPR_PTR hb_compExprNewSend( HB_EXPR_PTR, char * );

3
harbour/include/hbpcode.h
View File

@@ -190,8 +190,9 @@ typedef enum
HB_P_MACROLISTEND, /* 123 HB_P_MACROPUSHLIST envelope end. */
HB_P_MPUSHSTR, /* 124 Macro compiled pushed string */
HB_P_LOCALNEARADDINT, /* 125 Add/Subtract specified int into specified local without using the stack. */
HB_P_MACROPUSHREF, /* 126 Reference to macro variable @&mvar */
/* NOTE: This have to be the last definition */
HB_P_LAST_PCODE /* 126 this defines the number of defined pcodes */
HB_P_LAST_PCODE /* 127 this defines the number of defined pcodes */
} HB_PCODE;
#endif /* HB_PCODE_H_ */

8
harbour/makefile.bc
View File

@@ -335,6 +335,7 @@ RTL_LIB_OBJS = \
$(OBJ_DIR)\achoice.obj \
$(OBJ_DIR)\adir.obj \
$(OBJ_DIR)\alert.obj \
$(OBJ_DIR)\altd.obj \
$(OBJ_DIR)\browdb.obj \
$(OBJ_DIR)\browdbx.obj \
$(OBJ_DIR)\browse.obj \
@@ -1278,6 +1279,13 @@ $(OBJ_DIR)\alert.obj : $(OBJ_DIR)\alert.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\altd.c : $(RTL_DIR)\altd.prg
$(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@
$(OBJ_DIR)\altd.obj : $(OBJ_DIR)\altd.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\ampm.obj : $(RTL_DIR)\ampm.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) $(ARFLAGS) -+$@,,

1
harbour/makefile.nt
View File

@@ -388,6 +388,7 @@ RTL_LIB_OBJS = \
$(OBJ_DIR)\achoice.obj \
$(OBJ_DIR)\adir.obj \
$(OBJ_DIR)\alert.obj \
$(OBJ_DIR)\altd.obj \
$(OBJ_DIR)\browdb.obj \
$(OBJ_DIR)\browdbx.obj \
$(OBJ_DIR)\browse.obj \

1
harbour/makefile.vc
View File

@@ -352,6 +352,7 @@ RTL_LIB_OBJS = \
$(OBJ_DIR)\achoice.obj \
$(OBJ_DIR)\adir.obj \
$(OBJ_DIR)\alert.obj \
$(OBJ_DIR)\altd.obj \
$(OBJ_DIR)\browdb.obj \
$(OBJ_DIR)\browdbx.obj \
$(OBJ_DIR)\browse.obj \

14
harbour/source/common/expropt1.c
View File

@@ -83,6 +83,7 @@ static char * s_OperTable[] = {
"Array",
"@",
"@",
"@",
"IIF",
",",
",",
@@ -316,6 +317,19 @@ HB_EXPR_PTR hb_compExprNewFunRef( char * szFunName )
return pExpr;
}
HB_EXPR_PTR hb_compExprNewRef( HB_EXPR_PTR pRefer )
{
HB_EXPR_PTR pExpr;
HB_TRACE(HB_TR_DEBUG, ("hb_compExprNewRef(%p)", pRefer));
pExpr =hb_compExprNew( HB_ET_REFERENCE );
pExpr->value.asReference = pRefer;
pExpr->ValType = HB_EV_VARREF;
return pExpr;
}
/* Creates a new literal array { item1, item2, ... itemN }
* 'pArrList' is a list of array elements
*/

7
harbour/source/common/hbffind.c
View File

@@ -684,6 +684,7 @@ static BOOL hb_fsFindNextLow( PHB_FFIND ffind )
/* TODO: HB_FA_LABEL handling */
string[ 0 ] = '\0';
if( ffind->bFirst )
{
char dirname[ _POSIX_PATH_MAX + 1 ];
@@ -694,7 +695,8 @@ static BOOL hb_fsFindNextLow( PHB_FFIND ffind )
dirname[ 0 ] = '\0';
info->pattern[ 0 ] = '\0';
strcpy( string, pszFileName );
/* strcpy( string, pszFileName ); */
strcpy( string, ffind->pszFileMask );
pos = strrchr( string, OS_PATH_DELIMITER );
if( pos )
{
@@ -710,7 +712,7 @@ static BOOL hb_fsFindNextLow( PHB_FFIND ffind )
}
if( info->pattern[ 0 ] == '\0' )
strcpy( info->pattern, "*.*" );
strcpy( info->pattern, "*" );
tzset();
@@ -804,7 +806,6 @@ static BOOL hb_fsFindNextLow( PHB_FFIND ffind )
PHB_FFIND hb_fsFindFirst( const char * pszFileMask, USHORT attrmask )
{
PHB_FFIND ffind = ( PHB_FFIND ) hb_xgrab( sizeof( HB_FFIND ) );
PHB_FFIND_INFO info;
/* Allocate platform dependent file find info storage */

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.9 - ignore this magic number - this is used to force compilation
* 1.10 - ignore this magic number - this is used to force compilation
*/
#include "hbexpra.c"

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

@@ -5,6 +5,6 @@
/* hbexprb.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.9 - ignore this magic number - this is used to force compilation
* 1.10 - ignore this magic number - this is used to force compilation
*/
#include "hbexprb.c"

12
harbour/source/compiler/genc.c
View File

@@ -819,6 +819,15 @@ static HB_GENC_FUNC( hb_p_macropush )
return 2;
}
static HB_GENC_FUNC( hb_p_macropushref )
{
HB_SYMBOL_UNUSED( pFunc );
HB_SYMBOL_UNUSED( lPCodePos );
fprintf( cargo->yyc, "\tHB_P_MACROPUSHREF,\n" );
return 1;
}
static HB_GENC_FUNC( hb_p_macropusharg )
{
HB_SYMBOL_UNUSED( pFunc );
@@ -1929,7 +1938,8 @@ static HB_GENC_FUNC_PTR s_verbose_table[] = {
/* start: more pcodes generated by macro compiler */
hb_p_dummy,
/* end: */
hb_p_localnearaddint
hb_p_localnearaddint,
hb_p_macropushref
};
static void hb_compGenCReadable( PFUNCTION pFunc, FILE * yyc )

1
harbour/source/compiler/harbour.c
View File

@@ -69,7 +69,6 @@ int hb_compMemvarGetPos( char *, PFUNCTION ); /* return if passed name is a memv
static void hb_compGenFieldPCode( BYTE , int, char *, PFUNCTION ); /* generates the pcode for database field */
static void hb_compGenVariablePCode( BYTE , char * ); /* generates the pcode for undeclared variable */
static void hb_compGenVarPCode( BYTE , char * ); /* generates the pcode for undeclared variable */
static PFUNCTION hb_compFunctionNew( char *, HB_SYMBOLSCOPE ); /* creates and initialises the _FUNC structure */
static PINLINE hb_compInlineNew( char * ); /* creates and initialises the _INLINE structure */

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

@@ -654,20 +654,13 @@ ArgList : Argument { $$ = hb_compExprNewArgList( $1 ); }
| ArgList ',' Argument { $$ = hb_compExprAddListExpr( $1, $3 ); }
;
Argument : EmptyExpression { $$ = $1; }
| '@' IdentName { $$ = hb_compExprNewVarRef( $2 ); }
| '@' IdentName '(' DummyArgList ')' { $$ = hb_compExprNewFunRef( $2 ); }
Argument : EmptyExpression { $$ = $1; }
| '@' IdentName { $$ = hb_compExprNewVarRef( $2 ); }
| '@' IdentName '(' ArgList ')' { $$ = hb_compExprNewFunRef( $2 ); hb_compExprDelete( $4 ); }
| '@' MacroVar { $$ = hb_compExprNewRef( $2 ); }
| '@' AliasVar { $$ = hb_compExprNewRef( $2 ); }
;
DummyArgList : DummyArgument {}
| DummyArgList ',' DummyArgument {}
;
DummyArgument : EmptyExpression {}
| '@' IdentName {}
| '@' IdentName '(' DummyArgList ')' {}
;
FunCallAlias : FunCall ALIASOP { $$ = $1; }
;
@@ -1330,6 +1323,15 @@ DecList : /* Nothing */ {}
| FormalList ',' OptList
;
DummyArgList : DummyArgument {}
| DummyArgList ',' DummyArgument {}
;
DummyArgument : EmptyExpression {}
| '@' IdentName {}
| '@' IdentName '(' DummyArgList ')' {}
;
FormalList : IdentName AsType { hb_compDeclaredParameterAdd( $1, hb_comp_cVarType ); }
| '@' IdentName AsType { hb_compDeclaredParameterAdd( $2, hb_comp_cVarType + VT_OFFSET_BYREF ); }
| '@' IdentName '(' DummyArgList ')' { hb_compDeclaredParameterAdd( $2, 'F' ); }
@@ -1683,11 +1685,13 @@ DoArgList : ',' { $$ = hb_compExprAddListExpr( hb_compExp
| DoArgList ',' DoArgument { $$ = hb_compExprAddListExpr( $1, $3 ); }
;
DoArgument : IdentName { $$ = hb_compExprNewVarRef( $1 ); }
| '@' IdentName { $$ = hb_compExprNewVarRef( $2 ); }
| '@' IdentName '(' DummyArgList ')' { $$ = hb_compExprNewFunRef( $2 ); }
| SimpleExpression { $$ = $1; }
| PareExpList { $$ = $1; }
DoArgument : IdentName { $$ = hb_compExprNewVarRef( $1 ); }
| '@' IdentName { $$ = hb_compExprNewVarRef( $2 ); }
| '@' IdentName '(' ArgList ')' { $$ = hb_compExprNewFunRef( $2 ); hb_compExprDelete( $4 ); }
| SimpleExpression { $$ = $1; }
| PareExpList { $$ = $1; }
| '@' MacroVar { $$ = hb_compExprNewRef( $2 ); }
| '@' AliasVar { $$ = hb_compExprNewRef( $2 ); }
;
Crlf : '\n' { hb_comp_bError = FALSE; }

3
harbour/source/compiler/hbfix.c
View File

@@ -408,7 +408,8 @@ static HB_FIX_FUNC_PTR s_fixlocals_table[] =
NULL, /* HB_P_MACROLIST, */
NULL, /* HB_P_MACROLISTEND, */
NULL, /* HB_P_MPUSHSTR */
hb_p_localnearaddint /* HB_P_LOCALNEARADDINT, */
hb_p_localnearaddint, /* HB_P_LOCALNEARADDINT, */
NULL /* HB_P_MACROPUSHREF */
};
void hb_compFixFuncPCode( PFUNCTION pFunc )

9
harbour/source/compiler/hbgenerr.c
View File

@@ -232,4 +232,11 @@ void hb_compErrorCodeblock( char * szBlock )
void hb_compErrorMacro( char *szText )
{
hb_compGenError( hb_comp_szErrors, 'E', HB_COMP_ERR_BAD_MACRO, szText, NULL );
}
}
HB_EXPR_PTR hb_compErrorRefer( HB_EXPR_PTR pExpr, char *szAlias )
{
char * szDesc = hb_compExprDescription( pExpr );
hb_compGenError( hb_comp_szErrors, 'E', HB_COMP_ERR_INVALID_REFER, szAlias, szDesc );
return pExpr;
}

3
harbour/source/compiler/hbpcode.c
View File

@@ -170,7 +170,8 @@ static BYTE s_pcode_len[] = {
1, /* HB_P_MACROLIST, */
1, /* HB_P_MACROLISTEND, */
0, /* HB_P_MPUSHSTR */
4 /* HB_P_LOCALNEARADDINT, */
4, /* HB_P_LOCALNEARADDINT, */
1 /* HB_P_MACROPUSHREF */
};
static PVAR hb_compPrivateFind( char * szPrivateName )

9
harbour/source/debug/dbgtwin.prg
View File

@@ -76,6 +76,7 @@ CLASS TDbWindow // Debugger windows and dialogs
METHOD Hide()
METHOD IsOver( nRow, nCol )
METHOD nWidth() INLINE ::nRight - ::nLeft + 1
METHOD Clear()
METHOD ScrollUp( nLines )
METHOD SetCaption( cCaption )
METHOD ShowCaption()
@@ -132,6 +133,14 @@ METHOD ScrollUp( nLines ) CLASS TDbWindow
return nil
METHOD Clear() CLASS TDbWindow
SetColor( ::cColor )
Scroll( ::nTop+1, ::nLeft+1, ::nBottom-1, ::nRight-1 )
RETURN nil
METHOD SetCaption( cCaption ) CLASS TDbWindow
::cCaption := cCaption

183
harbour/source/debug/debugger.prg
View File

@@ -83,6 +83,7 @@
#define CSTACK_LINE 3 //start line
#define CSTACK_MODULE 4 //module name (.PRG file)
#define CSTACK_STATICS 5 //an array with static variables
#define CSTACK_LEVEL 6 //eval stack level of the function
/* Information structure hold by aCallStack[n][ CSTACK_LOCALS ]
{ cLocalName, nLocalIndex, "Local", ProcName( 1 ) }
@@ -108,26 +109,6 @@ static s_oDebugger
static s_lExit := .F.
memvar __DbgStatics
procedure AltD( nAction )
do case
case nAction == nil
if SET( _SET_DEBUG )
s_lExit := .f.
if !s_oDebugger==nil // protects if altd() in code and debugger
// linked but not active
s_oDebugger:lGo := .F.
__dbgEntry( HB_DBG_SHOWLINE, ProcLine( 1 ) )
endif
endif
case nAction == ALTD_DISABLE
SET( _SET_DEBUG, .F. )
case nAction == ALTD_ENABLE
SET( _SET_DEBUG, .T. )
endcase
return
procedure __dbgEntry( nMode, uParam1, uParam2, uParam3 ) // debugger entry point
@@ -164,6 +145,7 @@ procedure __dbgEntry( nMode, uParam1, uParam2, uParam3 ) // debugger entry poin
s_oDebugger:lToCursor :=.F.
s_oDebugger:lNextRoutine :=.F.
s_oDebugger:aCallStack[ 1 ][CSTACK_LINE] := uParam1
s_oDebugger:nProcLevel := hb_dbg_Proclevel()-IIF(PROCNAME(1)=="ALTD",2,1)
s_oDebugger:Activate()
RETURN
ENDIF
@@ -173,7 +155,7 @@ procedure __dbgEntry( nMode, uParam1, uParam2, uParam3 ) // debugger entry poin
// set the current line number on the CallStack
if s_oDebugger:lTrace
//In TRACE mode (step over procedure)
IF( s_oDebugger:nProcLevel < Len( s_oDebugger:aCallStack ) )
IF( s_oDebugger:nTraceLevel < Len( s_oDebugger:aCallStack ) )
s_oDebugger:lTrace := (! s_oDebugger:IsBreakPoint( uParam1, s_oDebugger:aCallStack[1][ CSTACK_MODULE ] )) .AND.;
(! HB_DBG_INVOKEDEBUG())
if s_oDebugger:lTrace
@@ -220,6 +202,7 @@ procedure __dbgEntry( nMode, uParam1, uParam2, uParam3 ) // debugger entry poin
s_oDebugger:aCallStack[ 1 ][CSTACK_LINE] := uParam1
if !s_oDebugger:lGo .or. HB_DBG_INVOKEDEBUG()
s_oDebugger:lGo := .F.
s_oDebugger:nProcLevel := hb_dbg_Proclevel()-IIF(PROCNAME(1)=="ALTD",2,1)
s_oDebugger:Activate()
endif
@@ -318,7 +301,11 @@ CLASS TDebugger
DATA oBar, oBrwText, cPrgName, oBrwStack, oBrwVars, aVars
DATA cImage
DATA cAppImage, nAppRow, nAppCol, cAppColors, nAppCursor
DATA aBreakPoints, aCallStack, aColors
DATA aBreakPoints
DATA aCallStack //stack of procedures with debug info
DATA aProcStack //stack of all procedures
DATA nProcLevel //procedure level where the debugger is currently
DATA aColors
DATA aWatch, aTrace, lTracepoints
DATA aLastCommands, nCommand, oGetListCommand
DATA lAnimate, lEnd, lCaseSensitive, lMonoDisplay, lSortVars
@@ -328,7 +315,7 @@ CLASS TDebugger
DATA lShowCallStack
DATA lGo //stores if GO was requested
DATA lTrace //stores if TRACE over procedure was requested
DATA nProcLevel //procedure level where TRACE was requested
DATA nTraceLevel //procedure level where TRACE was requested
DATA lCodeblock INIT .F.
DATA lActive INIT .F.
DATA lCBTrace INIT .T. //stores if codeblock tracing is allowed
@@ -373,6 +360,7 @@ CLASS TDebugger
METHOD IsBreakPoint( nLine, cPrgName)
METHOD LoadSettings()
METHOD LoadVars()
METHOD LoadCallStack()
METHOD Local()
@@ -380,7 +368,8 @@ CLASS TDebugger
METHOD NextWindow()
METHOD Open()
METHOD OpenPPO()
METHOD Resume() INLINE IIF( LEN(::aCallStack[1])>0, ::ShowCodeLine( ::aCallStack[1][ CSTACK_LINE ], ::aCallStack[1][ CSTACK_MODULE ] ), NIL)
// METHOD Resume() INLINE IIF( LEN(::aCallStack[1])>0, ::ShowCodeLine( ::aCallStack[1][ CSTACK_LINE ], ::aCallStack[1][ CSTACK_MODULE ] ), NIL)
METHOD Resume() INLINE ::ShowCodeLine( 1 )
METHOD OSShell()
METHOD PathForFiles()
@@ -397,7 +386,7 @@ CLASS TDebugger
METHOD ShowAppScreen()
METHOD ShowCallStack()
METHOD ShowCodeLine( nLine, cPrgName )
METHOD StackProc(cModuleName)
METHOD StackProc(cModuleName, nProcLevel)
METHOD ShowHelp( nTopic )
METHOD ShowVars()
METHOD RedisplayBreakpoints()
@@ -421,7 +410,7 @@ CLASS TDebugger
METHOD ToggleBreakPoint()
METHOD Trace() INLINE ::lTrace := .t., ::nProcLevel := Len( ::aCallStack ),;
METHOD Trace() INLINE ::lTrace := .t., ::nTraceLevel := Len( ::aCallStack ),;
__Keyboard( Chr( 255 ) ) //forces a Step()
METHOD ToCursor()
@@ -473,6 +462,7 @@ METHOD New() CLASS TDebugger
::aTrace := {}
::lTracepoints := .F.
::aCallStack := {}
::aProcStack := {}
::aVars := {}
::lCaseSensitive := .f.
::cSearchString := ""
@@ -519,13 +509,15 @@ return Self
METHOD PathForFiles() CLASS TDebugger
::cPathForFiles := ::InputBox( "Search path for source files:", ::cPathForFiles )
IF RIGHT(::cPathForFiles,1)<>'\'
::cPathForFiles:=::cPathForFiles+'\'
IF RIGHT(::cPathForFiles,1) $ HB_OSPATHDELIMITERS()
::cPathForFiles:=::cPathForFiles + HB_OSPATHSEPARATOR()
ENDIF
return Self
METHOD Activate() CLASS TDebugger
::LoadCallStack()
IF( ! ::lActive )
::lActive := .T.
::Show()
@@ -540,8 +532,8 @@ METHOD Activate() CLASS TDebugger
IF( ::oWndPnt != NIL )
::WatchpointsShow()
ENDIF
// new function ShowCodeLine( nline, cFilename)
::ShowCodeLine( ::aCallStack[1][ CSTACK_LINE ], ::aCallStack[1][ CSTACK_MODULE ] )
// show the topmost procedure
::ShowCodeLine( 1 ) //::aCallStack[1][ CSTACK_LINE ], ::aCallStack[1][ CSTACK_MODULE ] )
::HandleEvent()
return nil
@@ -618,16 +610,16 @@ METHOD BuildBrowseStack() CLASS TDebugger
::oBrwStack := TBrowseNew( 2, MaxCol() - 14, MaxRow() - 7, MaxCol() - 1 )
::oBrwStack:ColorSpec := ::aColors[ 3 ] + "," + ::aColors[ 4 ] + "," + ::aColors[ 5 ]
::oBrwStack:GoTopBlock := { || ::oBrwStack:Cargo := 1 }
::oBrwStack:GoBottomBlock := { || ::oBrwStack:Cargo := Len( ::aCallStack ) }
::oBrwStack:GoBottomBlock := { || ::oBrwStack:Cargo := Len( ::aProcStack ) }
::oBrwStack:SkipBlock = { | nSkip, nOld | nOld := ::oBrwStack:Cargo,;
::oBrwStack:Cargo += nSkip,;
::oBrwStack:Cargo := Min( Max( ::oBrwStack:Cargo, 1 ),;
Len( ::aCallStack ) ), ::oBrwStack:Cargo - nOld }
Len( ::aProcStack ) ), ::oBrwStack:Cargo - nOld }
::oBrwStack:Cargo := 1 // Actual highligthed row
::oBrwStack:AddColumn( TBColumnNew( "", { || If( Len( ::aCallStack ) > 0,;
PadC( ::aCallStack[ ::oBrwStack:Cargo ][ CSTACK_FUNCTION ], 14 ), Space( 14 ) ) } ) )
::oBrwStack:AddColumn( TBColumnNew( "", { || If( Len( ::aProcStack ) > 0,;
PadC( ::aProcStack[ ::oBrwStack:Cargo ][1], 14 ), Space( 14 ) ) } ) )
endif
return nil
@@ -645,7 +637,7 @@ METHOD CallStackProcessKey( nKey ) CLASS TDebugger
endif
case nKey == K_END
if ::oBrwStack:Cargo < Len( ::aCallStack )
if ::oBrwStack:Cargo < Len( ::aProcStack )
::oBrwStack:GoBottom()
::oBrwStack:ForceStable()
lUpdate = .t.
@@ -659,7 +651,7 @@ METHOD CallStackProcessKey( nKey ) CLASS TDebugger
endif
case nKey == K_DOWN
if ::oBrwStack:Cargo < Len( ::aCallStack )
if ::oBrwStack:Cargo < Len( ::aProcStack )
::oBrwStack:Down()
::oBrwStack:ForceStable()
lUpdate = .t.
@@ -700,11 +692,14 @@ METHOD CallStackProcessKey( nKey ) CLASS TDebugger
endif
// jump to source line for a function
/*
if ::aCallStack[ ::oBrwStack:Cargo ][ CSTACK_LINE ] != nil
::ShowCodeLine( ::aCallStack[ ::oBrwStack:Cargo ][ CSTACK_LINE ], ::aCallStack[ ::oBrwStack:Cargo ][ CSTACK_MODULE ] )
else
::GotoLine( 1 )
endif
*/
::ShowCodeLine( ::oBrwStack:Cargo )
endif
return nil
@@ -1338,6 +1333,7 @@ METHOD ShowCallStack() CLASS TDebugger
local n := 1
local oCol
LOCAL i
::lShowCallStack = .t.
@@ -1384,6 +1380,28 @@ METHOD ShowCallStack() CLASS TDebugger
return nil
METHOD LoadCallStack() CLASS TDebugger
LOCAL i
LOCAL nDebugLevel
LOCAL nCurrLevel
LOCAL nlevel, nPos
::aProcStack := ARRAY( ::nProcLevel )
nCurrLevel := hb_dbg_ProcLevel() - 1
nDebugLevel := nCurrLevel - ::nProcLevel +1
FOR i:=nDebugLevel TO nCurrLevel
nLevel := nCurrLevel - i +1
nPos := ASCAN( ::aCallStack, {|a| a[CSTACK_LEVEL]==nLevel} )
IF( nPos > 0 )
//a procedure with debug info
::aProcStack[i-nDebugLevel+1] := ::aCallStack[ nPos ]
ELSE
::aProcStack[i-nDebugLevel+1] := { PROCNAME( i ), ,,,, nLevel }
ENDIF
NEXT
RETURN NIL
METHOD LoadSettings() CLASS TDebugger
local cInfo := MemoRead( ::cSettingsFileName )
@@ -1474,36 +1492,38 @@ METHOD LoadVars() CLASS TDebugger // updates monitored variables
next
endif
if ::lShowStatics
if Type( "__DbgStatics" ) == "A"
cName := ::aCallStack[ ::oBrwStack:Cargo ][ CSTACK_MODULE ]
n := ASCAN( __dbgStatics, {|a| a[1]==cName} )
IF( n > 0 )
aVars := __DbgStatics[ n ][ 2 ]
for m := 1 to Len( aVars )
AAdd( aBVars, aVars[ m ] )
IF( ::aProcStack[::oBrwStack:Cargo ][ CSTACK_LINE ] != nil )
if ::lShowStatics
if Type( "__DbgStatics" ) == "A"
cName := ::aProcStack[ ::oBrwStack:Cargo ][ CSTACK_MODULE ]
n := ASCAN( __dbgStatics, {|a| a[1]==cName} )
IF( n > 0 )
aVars := __DbgStatics[ n ][ 2 ]
for m := 1 to Len( aVars )
AAdd( aBVars, aVars[ m ] )
next
ENDIF
aVars := ::aProcStack[ ::oBrwStack:Cargo ][ CSTACK_STATICS ]
for n := 1 to Len( aVars )
AAdd( aBVars, aVars[ n ] )
next
ENDIF
aVars := ::aCallStack[ ::oBrwStack:Cargo ][ CSTACK_STATICS ]
endif
endif
if ::lShowLocals
aVars := ::aProcStack[ ::oBrwStack:Cargo ][ CSTACK_LOCALS ]
for n := 1 to Len( aVars )
AAdd( aBVars, aVars[ n ] )
cName := aVars[ n ][ VAR_NAME ]
m := AScan( aBVars,; // Is there another var with this name ?
{ | aVar | aVar[ VAR_NAME ] == cName .AND. aVar[VAR_TYPE]=='S'} )
IF( m > 0 )
aBVars[ m ] := aVars[ n ]
ELSE
AAdd( aBVars, aVars[ n ] )
ENDIF
next
endif
endif
if ::lShowLocals
aVars := ::aCallStack[ ::oBrwStack:Cargo ][ CSTACK_LOCALS ]
for n := 1 to Len( aVars )
cName := aVars[ n ][ VAR_NAME ]
m := AScan( aBVars,; // Is there another var with this name ?
{ | aVar | aVar[ VAR_NAME ] == cName .AND. aVar[VAR_TYPE]=='S'} )
IF( m > 0 )
aBVars[ m ] := aVars[ n ]
ELSE
AAdd( aBVars, aVars[ n ] )
ENDIF
next
endif
ENDIF
IF( ::oBrwVars != NIL .AND. ::oBrwVars:cargo[1] > LEN(aBVars) )
::oBrwVars:gotop()
@@ -1619,6 +1639,8 @@ METHOD ShowVars() CLASS TDebugger
elseif Len( ::aVars ) < ::oWndVars:nBottom - ::oWndVars:nTop - 1
::oWndVars:Resize( ,, ::oWndVars:nTop + Len( ::aVars ) + 1 )
lRepaint := .t.
else
::oBrwVars:refreshAll():ForceStable()
endif
if ! ::oWndVars:lVisible .OR. lRepaint
::ResizeWindows( ::oWndVars )
@@ -1657,7 +1679,7 @@ static function CompareLine( Self )
return { | a | a[ 1 ] == Self:oBrwText:nRow } // it was nLine
METHOD StackProc( cModuleName ) CLASS TDebugger
METHOD StackProc( cModuleName, nProcLevel ) CLASS TDebugger
// always treat filename as lower case - we need it consistent for comparisons
LOCAL nPos:=RAT( ":", cModuleName )
@@ -1669,11 +1691,14 @@ METHOD StackProc( cModuleName ) CLASS TDebugger
{},; //local vars
nil,; //line no
lower(LEFT( cModuleName, nPos - 1 )),; // and the module name
{} } // static vars
{},; // static vars
nProcLevel }
return nil
METHOD ShowCodeLine( nLine, cPrgName ) CLASS TDebugger
LOCAL nPos
//METHOD ShowCodeLine( nLine, cPrgName ) CLASS TDebugger
METHOD ShowCodeLine( nProc ) CLASS TDebugger
LOCAL nPos, nLevel
LOCAL nLine, cPrgName
// we only update the stack window and up a new browse
// to view the code if we have just broken execution
@@ -1682,6 +1707,18 @@ LOCAL nPos
::oBrwStack:RefreshAll()
endif
nLine := ::aProcStack[ nProc ][ CSTACK_LINE ]
cPrgName := ::aProcStack[ nProc ][ CSTACK_MODULE ]
IF( nLine == NIL )
::oBrwText := nil
::oWndCode:Browser := nil
::oWndCode:SetCaption( ::aProcStack[ nProc ][ CSTACK_FUNCTION ] +;
": Code not available" )
::oWndCode:Refresh() // to force the window caption to update
RETURN nil
ENDIF
if( ::lppo )
nPos :=RAT(".PRG", UPPER(cPrgName) )
IF( nPos > 0 )
@@ -1690,7 +1727,7 @@ LOCAL nPos
cPrgName += cPrgName +".ppo"
ENDIF
endif
if cPrgName != ::cPrgName
if( cPrgName != ::cPrgName .OR. ::oBrwText == NIL )
if ! File( cPrgName ) .and. ! Empty( ::cPathForFiles )
cPrgName := ::LocatePrgPath( cPrgName )
endif
@@ -1702,13 +1739,14 @@ LOCAL nPos
__DbgColors()[ 3 ] + "," + __DbgColors()[ 6 ] )
::oWndCode:Browser := ::oBrwText
::oWndCode:bPainted :={|| ::oBrwText:refreshAll():forceStable() }
::oWndCode:bPainted :={|| IIF(::oBrwText!=nil,::oBrwText:refreshAll():forceStable(),::oWndCode:Clear()) }
::RedisplayBreakpoints() // check for breakpoints in this file and display them
::oWndCode:SetCaption( ::cPrgName )
::oWndCode:Refresh() // to force the window caption to update
endif
::GoToLine( nLine )
endif
return nil
METHOD Open() CLASS TDebugger
@@ -1966,11 +2004,12 @@ METHOD GotoLine( nLine ) CLASS TDebugger
nCol = Col()
// no source code line stored yet
/*
if ::oBrwStack != nil .and. Len( ::aCallStack ) > 0 .and. ;
::aCallStack[ ::oBrwStack:Cargo ][ CSTACK_LINE ] == nil
::aCallStack[ ::oBrwStack:Cargo ][ CSTACK_LINE ] = nLine
endif
*/
if ::oWndStack != nil .and. ! ::oBrwStack:Stable
::oBrwStack:ForceStable()
endif
@@ -2737,20 +2776,20 @@ LOCAL bEBlock
FOR i:=1 TO nLen
cVar := aWatch[ i + WP_BLOCK ]
//search local variables in current procedure
aLocVars := s_oDebugger:aCallStack[1][CSTACK_LOCALS]
aLocVars := s_oDebugger:aProcStack[1][CSTACK_LOCALS]
nPos := ASCAN( aLocVars, {|a| a[VAR_NAME]==cVar} )
IF( nPos > 0 )
j :=hb_dbg_ProcLevel() - aLocVars[ nPos ][ VAR_LEVEL ]
aVars[i] := hb_dbg_vmVarLGet( j, aLocVars[ nPos ][ VAR_POS ] )
ELSE
//search local statics
aLocVars := s_oDebugger:aCallStack[1][CSTACK_STATICS]
aLocVars := s_oDebugger:aProcStack[1][CSTACK_STATICS]
nPos := ASCAN( aLocVars, {|a| a[VAR_NAME]==cVar} )
IF( nPos > 0 )
aVars[i] := hb_dbg_vmVarSGet( aLocVars[ nPos ][VAR_LEVEL], aLocVars[ nPos ][VAR_POS] )
ELSE
//search global statics
cName := s_oDebugger:aCallStack[1][CSTACK_MODULE]
cName := s_oDebugger:aProcStack[1][CSTACK_MODULE]
nPos := ASCAN( __dbgStatics, {|a| a[1]==cName} )
IF( nPos > 0 )
aLocVars := __dbgStatics[nPos][ 2 ]

1
harbour/source/macro/macro.y
View File

@@ -424,6 +424,7 @@ ArgList : Argument { $$ = hb_compExprNewArgList( $1 ); }
Argument : EmptyExpression { $$ = $1; }
| '@' IDENTIFIER { $$ = hb_compExprNewVarRef( $2 ); }
| '@' AliasVar { $$ = hb_compExprNewRef( $2 ); }
| '@' IDENTIFIER '(' ')' { $$ = hb_compExprNewFunRef( $2 ); }
;

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.9 - ignore this magic number - this is used to force compilation
* 1.10 - ignore this magic number - this is used to force compilation
*/
#define HB_MACRO_SUPPORT

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

@@ -5,7 +5,7 @@
/* hbexprb.c is also included from ../compiler/exproptb.c
* However it produces a slighty different code if used in
* macro compiler (there is an additional parameter passed to some functions)
* 1.8 - ignore this magic number - this is used to force compilation
* 1.9 - ignore this magic number - this is used to force compilation
*/
#define HB_MACRO_SUPPORT

1
harbour/source/rtl/Makefile
View File

@@ -123,6 +123,7 @@ PRG_SOURCES=\
achoice.prg \
adir.prg \
alert.prg \
altd.prg \
browdb.prg \
browdbx.prg \
browse.prg \

79
harbour/source/rtl/altd.prg Normal file
View File

@@ -0,0 +1,79 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* ALTD() procedure
*
* Copyright 2004 Ryszard Glab <rglab@imid.med.pl>
* 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:
*
* 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.
*
*/
#define ALTD_DISABLE 0
#define ALTD_ENABLE 1
PROCEDURE AltD( nAction )
DO CASE
CASE nAction == nil
/* do not activate the debugger imediatelly because the module
where ALTD() was called can have no debugger info - stop
on first LINE with debugged info
*/
HB_DBG_INVOKEDEBUG( SET( _SET_DEBUG ) )
CASE nAction == ALTD_DISABLE
SET( _SET_DEBUG, .F. )
CASE nAction == ALTD_ENABLE
SET( _SET_DEBUG, .T. )
ENDCASE
RETURN

26
harbour/source/vm/hvm.c
View File

@@ -1493,6 +1493,24 @@ void HB_EXPORT hb_vmExecute( const BYTE * pCode, PHB_SYMB pSymbols )
w++;
break;
case HB_P_MACROPUSHREF:
{
PHB_ITEM pMacro = hb_stackItemFromTop( -1 );
PHB_SYMB pSym;
/* compile into a symbol name (used in function calls) */
hb_macroPushSymbol( pMacro );
/* NOTE: pMacro string is replaced with a symbol.
* Symbol is created if it doesn't exist.
*/
pSym = pMacro->item.asSymbol.value;
/* NOTE: pMacro item of symbol type is replaced with
* the reference
*/
hb_memvarGetRefer( pMacro, pSym );
w++;
}
break;
case HB_P_MACROSYMBOL:
/* compile into a symbol name (used in function calls) */
hb_macroPushSymbol( hb_stackItemFromTop( -1 ) );
@@ -5023,10 +5041,16 @@ void hb_vmRequestDebug( void )
s_bDebugRequest = TRUE;
}
/* check if the debugger activation was requested or request the debugger
activation if .T. is passed
*/
HB_FUNC( HB_DBG_INVOKEDEBUG )
{
BOOL bRequest = s_bDebugRequest;
s_bDebugRequest = FALSE;
if( hb_pcount() > 0 )
s_bDebugRequest = hb_parl(1);
else
s_bDebugRequest = FALSE;
hb_retl( bRequest );
}