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

ChangeLog 19990808-20:55

Browse Source
This commit is contained in:
Ryszard Glab
1999-08-08 19:05:34 +00:00
parent e84bc8428c
commit e4fc927645
16 changed files with 1158 additions and 378 deletions
Download Patch File Download Diff File Expand all files Collapse all files

81
harbour/ChangeLog
View File

@@ -1,3 +1,84 @@
19990808-20:55 GMT+2 Ryszard Glab <rglab@imid.med.pl>
*source/compiler/harbour.y
* corrected checking for duplicated variable names when
MEMVAR and PRIVATE variable was declared
* Arguments used in DO ... WITH ... are pushed correctly now
using either a value or a reference
* RETURN statement is no longer generating JMP opcodes - it generates
HB_P_ENDPROC opcode now
* generated C code again includes "init.h"
+ added support for aliased expressions (it seems that generated
C code is correct)
*source/rtl/do.c
+ added documentation
*source/rtl/memvars.c
+ added __MVSCOPE function to check if variable is created already
*include/memvars.ch
! new file that defines the values returned from __MVSCOPE
function
*include/hb_vmpub.h
*include/extend.h
* changed to not duplicate definition of structures and type.
Duplicated definitions have caused undefined symbols during
linking of C++ compiler (Watcom) output. The C++ compilers
can mangle function's name into different names when
duplicated definitions of data types are used.
*source/rtl/initsymb.c
+ added again '#include "init.h"' - because some definitions
were moved into hb_vmpub.h to avoid problems with duplicated
definitions of data types.
*include/langapi.h
- removed declaration of extern langDef (Watcom reported error)
see TODO comment in this file
*include/pcode.h
- removed unused HB_P_PUSHWORD
+ added opcodes:
HB_P_POPALIAS
HB_P_PUSHALIAS
HB_P_SWAPALIAS
HB_P_POPFIELD
HB_P_PUSHFIELD
HB_P_POPALIASEDFIELD
HB_P_PUSHALIASEDFIELD
NOTE:
You have to rebuild all harbour libraries and object files !
*source/vm/hvm.c
+ added initial support for aliased expressions (fields are not
handled yet - we need to synchronize it with RDD development)
*include/hberrors.h
+ added ERR_INVALID_REFER reported when field or aliased variable
is passed by the reference
*tests/working/alias.prg
+ new file to check if aliased expressions are handled correctly
(only manual check at this moment - by looking at generated
C code)
*test/working/Makefile
+ added alias.prg into BAD_PRG_SOURCES because it cannot be run yet
- removed debugger.prg
*source/rtl/console.c
- io.h cannot be included on Linux/GCC (placed inside #ifdef)
*source/vm/dynsym.c
+ restored definition of SYM_ALLOCATED because it is local symbol
NOTE:
When compared then this symbol _have to_ be type casted
to SYMBOLSCOPE. If it will be not type casted then some
compilers will compare (int)-1 with (char)-1 which is never
true! (I am changing it for the second time :)
19990808-11:50 GMT+1 Victor Szel <info@szelvesz.hu>
* source/runner/runner.c
source/runner/Makefile

31
harbour/include/extend.h
View File

@@ -33,6 +33,7 @@
#include <string.h>
#include "hbdefs.h"
#include "hbsetup.h"
#include "hb_vmpub.h"
#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY
/* Clipper includes these from extend.h */
@@ -40,27 +41,6 @@
#include "fm.api"
#endif
struct _HB_DYNS; /* forward declaration */
/* symbol support structure */
typedef struct
{
char* szName; /* the name of the symbol */
SYMBOLSCOPE cScope; /* the scope of the symbol */
PHB_FUNC pFunPtr; /* function address for function symbol table entries */
struct _HB_DYNS * pDynSym; /* pointer to its dynamic symbol if defined */
} HB_SYMB, * PHB_SYMB, * HB_SYMB_PTR;
/* Harbour Functions scope (SYMBOLSCOPE) */
#define FS_PUBLIC 0x00
#define FS_STATIC 0x02
#define FS_INIT 0x08
#define FS_EXIT 0x10
#define FS_INITEXIT ( FS_INIT | FS_EXIT )
#define FS_MESSAGE 0x20
#define FS_MEMVAR 0x80
#define FS_ALLOCATED (-1)
/* items types */
#define IT_NIL 0x0000
#define IT_INTEGER 0x0002
@@ -211,15 +191,6 @@ typedef struct
char szDate[ 9 ]; /* last returned date from _pards() yyyymmdd format */
} STACK;
/* dynamic symbol structure */
typedef struct _HB_DYNS
{
HB_HANDLE hArea; /* Workarea number */
HB_HANDLE hMemvar; /* Index number into memvars ( publics & privates ) array */
PHB_SYMB pSymbol; /* pointer to its relative local symbol */
PHB_FUNC pFunPtr; /* Pointer to the function address */
} HB_DYNS, * PHB_DYNS, * HB_DYNS_PTR;
/* internal structure for codeblocks */
typedef struct _HB_CODEBLOCK
{

44
harbour/include/hb_vmpub.h
View File

@@ -37,35 +37,10 @@
#ifndef HB_VMPUB_H_
#define HB_VMPUB_H_
#include "hbdefs.h"
#include "pcode.h"
/* Dummy definitions */
typedef void * PHB_DYNS;
/* Parts copied from hbdefs.h */
typedef unsigned char BYTE; /* 1 byte unsigned */
typedef unsigned short int WORD;
#ifdef __GNUC__
#define pascal __attribute__ ((stdcall))
#endif
#ifdef _MSC_VER
#define HARBOUR void
#else
#ifdef __IBMCPP__
#define HARBOUR void
#else
#define HARBOUR void pascal
#endif
#endif
typedef void * PHB_FUNC;
typedef char SYMBOLSCOPE; /* stores symbol's scope */
/* Parts copied from extend.h */
struct _HB_DYNS;
/* symbol support structure */
typedef struct
@@ -73,10 +48,17 @@ typedef struct
char * szName; /* the name of the symbol */
SYMBOLSCOPE cScope; /* the scope of the symbol */
PHB_FUNC pFunPtr; /* function address for function symbol table entries */
PHB_DYNS pDynSym; /* pointer to its dynamic symbol if defined */
struct _HB_DYNS *pDynSym; /* pointer to its dynamic symbol if defined */
} HB_SYMB, * PHB_SYMB;
extern void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols ); /* invokes the virtual machine */
/* dynamic symbol structure */
typedef struct _HB_DYNS
{
HB_HANDLE hArea; /* Workarea number */
HB_HANDLE hMemvar; /* Index number into memvars ( publics & privates ) array */
PHB_SYMB pSymbol; /* pointer to its relative local symbol */
PHB_FUNC pFunPtr; /* Pointer to the function address */
} HB_DYNS, * PHB_DYNS, * HB_DYNS_PTR;
/* Harbour Functions scope (SYMBOLSCOPE) */
#define FS_PUBLIC 0x00
@@ -87,8 +69,6 @@ extern void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols ); /* invokes the vir
#define FS_MESSAGE 0x20
#define FS_MEMVAR 0x80
/* This should always follow the type declarations */
#include "init.h"
extern void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols ); /* invokes the virtual machine */
#endif /* HB_VMPUB_H_ */

1
harbour/include/hberrors.h
View File

@@ -61,6 +61,7 @@
#define ERR_INCOMPLETE_STMT 20
#define ERR_CHECKING_ARGS 21
#define ERR_INVALID_LVALUE 22
#define ERR_INVALID_REFER 23
#define WARN_AMBIGUOUS_VAR 1
#define WARN_MEMVAR_ASSUMED 2

7
harbour/include/langapi.h
View File

@@ -71,8 +71,13 @@ typedef struct _HB_LANGNODE
struct _HB_LANGNODE * pNext;
} HB_LANGNODE, * PHB_LANGNODE;
/* TODO: check if it have to be visible outside of langapi.c
* It it is required then there is a conflict:
* it is declared here as 'extern' and in langapi.c it is declared as
* 'static' - Watcom compiler reports error for this conflict
*/
/* extern PHB_LANG langDef; */
extern PHB_LANGNODE langList;
extern PHB_LANG langDef;
/* Supported language list management */

14
harbour/include/memvars.ch Normal file
View File

@@ -0,0 +1,14 @@
/*
* $Id$
*/
/* NOTE: This file is also used by C code. */
// Values returned from __MVSCOPE function
//
#define MV_NOT_FOUND -2 //not found in the symbols table
#define MV_UNKNOWN -1 //not created yet
#define MV_ERROR 0 //information cannot be obtained
#define MV_PUBLIC 1 //PUBLIC variable
#define MV_PRIVATE_GLOBAL 2 //PRIVATE created outside of current function/procedure
#define MV_PRIVATE_LOCAL 3 //PRIVATE created in current function/procedure

12
harbour/include/pcode.h
View File

@@ -58,11 +58,11 @@ typedef enum
HB_P_LESSEQUAL, /* checks if the second latest value on the stack is less equal that the latest one, leaves the result only */
HB_P_LESS, /* checks if the second latest value on the stack is less that the lastest one */
HB_P_LINE, /* currently compiled source code line number */
HB_P_LOCALNAME, /* name of locals and parmaters when using debugger info */
HB_P_LOCALNAME, /* sets the name of local variable */
HB_P_MESSAGE, /* sends a message to an object */
HB_P_MINUS, /* subs the latest two values on the stack, removing them and leaving there the result */
HB_P_MODULENAME, /* name of the PRG file and function when using debugger info */
HB_P_MODULUS, /* calculates the modulus of the two values on the stack, removing them and leaving there the result */
HB_P_MODULENAME, /* sets the name of debugged module */
HB_P_MULT, /* multiplies the latest two values on the stack, removing them and leaving there the result */
HB_P_NEGATE, /* numerically negates the latest value on the stack */
HB_P_NOOP, /* no operation */
@@ -72,11 +72,17 @@ typedef enum
HB_P_PARAMETER, /* creates PRIVATE variables and assigns values to functions paramaters */
HB_P_PLUS, /* adds the latest two values on the stack, removing them and leaving there the result */
HB_P_POP, /* removes the latest value from the stack */
HB_P_POPALIAS, /* pops the item from the eval stack and selects the current workarea */
HB_P_POPALIASEDFIELD,/* pops aliased field */
HB_P_POPFIELD, /* pops unaliased field */
HB_P_POPLOCAL, /* pops the contains of the virtual machine stack onto a local variable */
HB_P_POPMEMVAR, /* pops the contains of a memvar variable to the virtual machine stack */
HB_P_POPSTATIC, /* pops the contains of the virtual machine stack onto a static variable */
HB_P_POWER, /* calculates the power of the two values on the stack, removing them and leaving there the result */
HB_P_PUSHALIAS, /* saves the current workarea number on the eval stack */
HB_P_PUSHALIASEDFIELD, /* pushes aliased field */
HB_P_PUSHBLOCK, /* start of a codeblock definition */
HB_P_PUSHFIELD, /* pushes unaliased field */
HB_P_PUSHINT, /* places an integer number on the virtual machine stack */
HB_P_PUSHLOCAL, /* pushes the contains of a local variable to the virtual machine stack */
HB_P_PUSHLOCALREF, /* pushes a local variable by reference to the virtual machine stack */
@@ -90,10 +96,10 @@ typedef enum
HB_P_PUSHSTATICREF, /* pushes the a static variable by reference to the virtual machine stack */
HB_P_PUSHSTR, /* places a string on the virtual machine stack */
HB_P_PUSHSYM, /* places a symbol on the virtual machine stack */
HB_P_PUSHWORD, /* places a two bytes number on the virtual machine stack */
HB_P_RETVALUE, /* instructs the virtual machine to return the latest stack value */
HB_P_SFRAME, /* sets the statics frame for a function */
HB_P_STATICS, /* defines the number of statics variables for a PRG */
HB_P_SWAPALIAS, /* restores the current workarea number from the eval stack */
HB_P_TRUE, /* pushes true on the virtual machine stack */
HB_P_ZERO /* places a zero on the virtual machine stack */
} HB_PCODE;

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

File diff suppressed because it is too large Load Diff

5
harbour/source/rtl/console.c
View File

@@ -54,10 +54,11 @@
#include "set.h"
#include "inkey.h"
#if defined(__GNUC__)
#if defined(__GNUC__) && ! defined(__DJGPP__)
#include <unistd.h>
#else
#include <io.h>
#endif
#include <io.h>
#include <fcntl.h>
#include "gtapi.h" /* HARBOUR_USE_GTAPI is checked inside gtapi.h, so that
we can always get the border styles */

45
harbour/source/rtl/do.c
View File

@@ -36,6 +36,51 @@
#include "errorapi.h"
#include "ctoharb.h"
/* $DOC$
* $FUNCNAME$
* DO()
* $CATEGORY$
* Utility
* $ONELINER$
* Calls a procedure or a function
* $SYNTAX$
* DO( <xFuncProc> [, <xArguments...>] )
* $ARGUMENTS$
* <xFuncProc> = Either a string with a function/procedure name to be called
* or a codeblock to evaluate
* <xArguments> = arguments passed to a called function/procedure or to
* a codeblock
* $RETURNS$
* A value that was returned from called function
* $DESCRIPTION$
* This function can be called either by the harbour compiler or by user.
* The compiler always passes the item of IT_SYMBOL type that stores the
* name of procedure specified in DO <proc> WITH ... statement.
* If called procedure/function doesn't exist then the runtime error
* is generated.
* This function can be used as replacement of macro operator.
* It is also used internally to implement DO <proc> WITH <args...>
* In this case <xFuncProc> is of type HB_SYMB
* $EXAMPLES$
* cbCode ={|x| MyFunc( x )}
* DO( cbCode, 1 )
*
* cFunction := "MyFunc"
* xRetVal :=DO( cFunction, 2 )
*
* Old style (slower):
* DO &cFunction WITH 3
*
* $TESTS$
*
* $STATUS$
*
* $COMPLIANCE$
*
* $SEEALSO$
*
* $END$
*/
HARBOUR HB_DO( void )
{
PHB_ITEM pItem;

163
harbour/source/rtl/memvars.c
View File

@@ -38,6 +38,7 @@
#include "itemapi.h"
#include "errorapi.h"
#include "error.ch"
#include "memvars.ch"
#define VS_PRIVATE 64
#define VS_PUBLIC 128
@@ -489,7 +490,7 @@ static void hb_memvarCreateFromDynSymbol( PHB_DYNS pDynVar, BYTE bScope, PHB_ITE
* It also restores the value that was hidden if there is another
* PRIVATE variable with the same name.
*/
void hb_memvarRelease( HB_ITEM_PTR pMemvar )
static void hb_memvarRelease( HB_ITEM_PTR pMemvar )
{
ULONG ulBase = _privateStackCnt;
PHB_DYNS pDynVar;
@@ -526,7 +527,7 @@ void hb_memvarRelease( HB_ITEM_PTR pMemvar )
* procedure only.
* The scope of released variables are specified using passed name's mask
*/
void hb_memvarReleaseWithMask( char *szMask, BOOL bInclude )
static void hb_memvarReleaseWithMask( char *szMask, BOOL bInclude )
{
ULONG ulBase = _privateStackCnt;
PHB_DYNS pDynVar;
@@ -551,6 +552,48 @@ void hb_memvarReleaseWithMask( char *szMask, BOOL bInclude )
}
}
static int hb_memvarScope( char *szVarName, ULONG ulLength )
{
int iMemvar = MV_ERROR;
char *szName;
szName =(char *)hb_xalloc( ulLength );
if( szName )
{
PHB_DYNS pDynVar;
memcpy( szName, szVarName, ulLength );
pDynVar =hb_dynsymFind( hb_strUpper( szName, ulLength-1 ) );
if( pDynVar )
{
if( pDynVar->hMemvar == 0 )
iMemvar =MV_UNKNOWN;
else
{
ULONG ulBase = _privateStackCnt; /* start from the top of the stack */
iMemvar =MV_PUBLIC;
while( ulBase )
{
--ulBase;
if( pDynVar == _privateStack[ ulBase ] )
{
if( ulBase >= _privateStackBase )
iMemvar =MV_PRIVATE_LOCAL;
else
iMemvar =MV_PRIVATE_GLOBAL;
ulBase =0;
}
}
}
}
else
iMemvar =MV_NOT_FOUND;
hb_xfree( szName );
}
return iMemvar;
}
/* ************************************************************************** */
@@ -709,14 +752,38 @@ HARBOUR HB___MVPRIVATE( void )
* $DESCRIPTION$
* This function releases values stored in memory variable. It shouldn't
* be called directly, rather it should be placed into RELEASE command.
* If the released variable is a PRIVATE variable then previously hidden
* variable with the same name becomes visible (after exit from the
* procedure where released variable was created).
* If the released variable is a PRIVATE variable then previously hidden
* variable with the same name becomes visible after exit from the
* procedure where released variable was created. If you access
* the released variable in the same function/procedure where it
* was created the the NIL value is returned. You can however assign
* a new value to released variable without any side effects.
*
* It releases variable even if this variable was created in different
* procedure
* $EXAMPLES$
*
* PROCEDURE MAIN()
* PRIVATE mPrivate
*
* mPrivate :="PRIVATE from MAIN()"
* ? mPrivate //PRIVATE from MAIN()
* Test()
* ? mPrivate //PRIVATE from MAIN()
*
* RETURN
*
* PROCEDURE Test()
* PRIVATE mPrivate
*
* mPrivate :="PRIVATE from Test()"
* ? mPrivate //PRIVATE from TEST()
* RELEASE mPrivate
* ? mPrivate //NIL
* mPrivate :="Again in Test()"
*
* RETURN
*
* $TESTS$
*
* $STATUS$
@@ -781,8 +848,13 @@ HARBOUR HB___MVXRELEASE( void )
* $DESCRIPTION$
* This function releases values stored in memory variables. It shouldn't
* be called directly, it should be placed into RELEASE ALL command.
* If released variable is a PRIVATE variable then the NIL is assigned.
* PUBLIC variables are not changed.
* If the released variable is a PRIVATE variable then previously hidden
* variable with the same name becomes visible after exit from the
* procedure where released variable was created. If you access
* the released variable in the same function/procedure where it
* was created the the NIL value is returned. You can however assign
* a new value to released variable without any side effects.
* PUBLIC variables are not changed by this function.
* $EXAMPLES$
*
* $TESTS$
@@ -814,7 +886,82 @@ HARBOUR HB___MVRELEASE( void )
if( pMask->item.asString.value[ 0 ] == '*' )
bIncludeVar =TRUE; /* delete all memvar variables */
hb_memvarReleaseWithMask( pMask->item.asString.value, bIncludeVar );
hb_memvarReleaseWithMask( pMask->item.asString.value, bIncludeVar );
}
}
}
/* $DOC$
* $FUNCNAME$
* __MVSCOPE()
* $CATEGORY$
* Variable management
* $ONELINER$
* If variable exists then returns its scope.
* $SYNTAX$
* __MVSCOPE( <cVarName> )
* $ARGUMENTS$
* <cVarName> = a string with a variable name to check
* $RETURNS$
* The symbolic values are defined in include/memvars.ch
* MV_NOT_FOUND =variable is not declared (not found in symbol table)
* MV_UNKNOWN =if variable doesn't exist (but found in symbol table)
* MV_ERROR =if information cannot be obtained (memory error or argument error)
* MV_PUBLIC =for public variables
* MV_PRIVATE_GLOBAL =for private variables declared outside of current function/procedure
* MV_PRIVATE_LOCAL =for private variables declared in current function/procedure
* $DESCRIPTION$
*
* $EXAMPLES$
*
* PROCEDURE MAIN()
* PUBLIC mPublic
* PRIVATE mPrivateGlobal
*
* CallProc()
* ? __mvScope( "mPrivateLocal" ) //MV_UNKNOWN
*
* RETURN
*
* PROCEDURE CallProc()
* PRIVATE mPrivateLocal
*
* ? __mvScope( "mPublic" ) //MV_PUBLIC
* ? __mvScope( "mPrivateGlobal" ) //MV_PRIVATE_GLOBAL
* ? __mvScope( "mPrivateLocal" ) //MV_PRIVATE_LOCAL
* ? __mvScope( "mFindMe" ) //MV_NOT_FOUND
*
* IF( __mvScope( "mPublic" ) > MV_ERROR )
* ? "Variable exists"
* ELSE
* ? "Variable not created yet"
* ENDIF
*
* RETURN
*
* $TESTS$
*
* $STATUS$
*
* $COMPLIANCE$
*
* $SEEALSO$
* include/memvars.ch
* $END$
*/
HARBOUR HB___MVSCOPE( void )
{
int iMemvar = MV_ERROR;
if( hb_pcount() )
{
PHB_ITEM pVarName;
pVarName =hb_param( 1, IT_STRING );
if( pVarName )
{
iMemvar =hb_memvarScope( pVarName->item.asString.value, pVarName->item.asString.length+1 );
}
}
hb_retni( iMemvar );
}

6
harbour/source/vm/dynsym.c
View File

@@ -28,6 +28,8 @@
#include "extend.h"
#define SYM_ALLOCATED -1
typedef struct
{
PHB_DYNS pDynSym; /* Pointer to dynamic symbol */
@@ -53,7 +55,7 @@ PHB_SYMB hb_symbolNew( char * szName ) /* Create a new symbol */
PHB_SYMB pSymbol = ( PHB_SYMB ) hb_xgrab( sizeof( HB_SYMB ) );
pSymbol->szName = ( char * ) hb_xgrab( strlen( szName ) + 1 );
pSymbol->cScope = FS_ALLOCATED; /* to know what symbols to release when exiting the app */
pSymbol->cScope = SYM_ALLOCATED; /* to know what symbols to release when exiting the app */
strcpy( pSymbol->szName, szName );
pSymbol->pFunPtr = NULL;
pSymbol->pDynSym = NULL;
@@ -193,7 +195,7 @@ void hb_dynsymRelease( void )
for( w = 0; w < wDynSymbols; w++ )
{
/* it is a allocated symbol ? */
if( ( pDynItems + w )->pDynSym->pSymbol->cScope == FS_ALLOCATED )
if( ( pDynItems + w )->pDynSym->pSymbol->cScope == (SYMBOLSCOPE)SYM_ALLOCATED )
{
hb_xfree( ( pDynItems + w )->pDynSym->pSymbol->szName );
hb_xfree( ( pDynItems + w )->pDynSym->pSymbol );

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

@@ -64,6 +64,7 @@ HARBOUR HB_EVAL( void ); /* Evaluates a codeblock from Harbour */
HARBOUR HB_LEN( void ); /* Evaluates a codeblock from Harbour */
HARBOUR HB_EMPTY( void ); /* fixed entry point by now */
HARBOUR HB_VALTYPE( void ); /* returns a string description of a value */
HARBOUR HB_ERRORBLOCK( void );
HARBOUR HB_PROCNAME( void );
HARBOUR HB_PROCLINE( void );
@@ -72,6 +73,14 @@ HARBOUR HB_ERRORLEVEL( void );
HARBOUR HB_PCOUNT( void );
HARBOUR HB_PVALUE( void );
static void AliasPop( void ); /* pops the workarea number form the eval stack */
static void AliasPush( void ); /* pushes the current workarea number */
static void AliasSwap( void ); /* swaps items on the eval stack and pops the workarea number */
static void PopAliasedField( PHB_SYMB ); /* pops an aliased field from the eval stack*/
static void PopField( PHB_SYMB ); /* pops an unaliased field from the eval stack */
static void PushAliasedField( PHB_SYMB ); /* pushes an aliased field on the eval stack */
static void PushField( PHB_SYMB ); /* pushes an unaliased field on the eval stack */
#ifdef HARBOUR_OBJ_GENERATION
typedef struct
@@ -412,10 +421,27 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols )
break;
case HB_P_POP:
hb_stackPop();
hb_stackPop();
w++;
break;
case HB_P_POPALIAS:
AliasPop();
w++;
break;
case HB_P_POPALIASEDFIELD:
wParams = pCode[ w + 1 ] + ( pCode[ w + 2 ] * 256 );
PopAliasedField( pSymbols + wParams );
w += 3;
break;
case HB_P_POPFIELD:
wParams = pCode[ w + 1 ] + ( pCode[ w + 2 ] * 256 );
PopField( pSymbols + wParams );
w += 3;
break;
case HB_P_POPLOCAL:
hb_vmPopLocal( pCode[ w + 1 ] + ( pCode[ w + 2 ] * 256 ) );
w += 3;
@@ -437,6 +463,17 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols )
w++;
break;
case HB_P_PUSHALIAS:
AliasPush();
w++;
break;
case HB_P_PUSHALIASEDFIELD:
wParams = pCode[ w + 1 ] + ( pCode[ w + 2 ] * 256 );
PushAliasedField( pSymbols + wParams );
w += 3;
break;
case HB_P_PUSHBLOCK:
/* +0 -> _pushblock
* +1 +2 -> size of codeblock
@@ -453,6 +490,12 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols )
w += 1 + sizeof( double ) + 1;
break;
case HB_P_PUSHFIELD:
wParams = pCode[ w + 1 ] + ( pCode[ w + 2 ] * 256 );
PushField( pSymbols + wParams );
w += 3;
break;
case HB_P_PUSHINT:
hb_vmPushInteger( pCode[ w + 1 ] + ( pCode[ w + 2 ] * 256 ) );
w += 3;
@@ -517,6 +560,11 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols )
w += 3;
break;
case HB_P_SWAPALIAS:
AliasSwap();
w++;
break;
case HB_P_RETVALUE:
hb_vmRetValue();
w++;
@@ -559,6 +607,88 @@ void hb_vmExecute( BYTE * pCode, PHB_SYMB pSymbols )
HB_DEBUG( "EndProc\n" );
}
/* Pops the item from the eval stack and uses it to select the current
* workarea
*/
static void AliasPop( void )
{
PHB_ITEM pItem;
hb_stackDec();
pItem = stack.pPos;
switch( pItem->type & ~IT_BYREF )
{
case IT_INTEGER:
/* Alias was used as integer value, for example: 4->field
* or it was saved on the stack using AliasPush()
* or was evaluated from an expression, (nWorkArea)->field
*/
/* TODO: synchronize it with RDD API
hb_SelectWorkAreaNumber( pItem->item.asInteger.value );
*/
pItem->type = IT_NIL;
break;
case IT_SYMBOL:
/* Alias was specified using alias identifier, for example: al->field
*/
/* TODO: synchronize it with RDD API
hb_SelectWorkAreaNumber( pItem->item.asSymbol.value->pDynSym.hArea );
*/
pItem->type = IT_NIL;
break;
case IT_STRING:
/* Alias was evaluated from an expression, for example: (cVar)->field
*/
/* TODO: synchronize it with RDD API
hb_SelectWorkAreaAlias( pItem->item.asString.value );
*/
hb_itemClear( pItem );
break;
default:
hb_itemClear( pItem );
hb_errorRT_BASE( EG_BADALIAS, 1000, NULL, NULL );
break;
}
HB_DEBUG( "AliasPop\n" );
}
/* pushes current workarea number on the eval stack
*/
static void AliasPush( void )
{
stack.pPos->type = IT_INTEGER;
/* TODO: synchronize it with RDD API
*/
stack.pPos->item.asInteger.value = 0; /* hb_GetCurrentWorkAreaNumber(); */
stack.pPos->item.asInteger.length = 10;
stack.pPos->item.asInteger.decimal = 0;
hb_stackPush();
HB_DEBUG( "AliasPush\n" );
}
/* Swaps two last items on the eval stack - the last item after swaping
* is popped as current workarea number
*/
static void AliasSwap( void )
{
HB_ITEM_PTR pItem = stack.pPos -1;
HB_ITEM_PTR pWorkArea = stack.pPos -2;
/* TODO: synchronize it with RDD API
hb_SelectWorkAreaNumber( pWorkArea->item.asInteger.value );
*/
memcpy( pWorkArea, pItem, sizeof( HB_ITEM ) );
pItem->type =IT_NIL;
hb_stackDec();
HB_DEBUG( "AliasSwap\n" );
}
void hb_vmAnd( void )
{
PHB_ITEM pItem2 = stack.pPos - 1;
@@ -1434,6 +1564,15 @@ long hb_vmPopDate( void )
}
}
static void PopAliasedField( PHB_SYMB pSym )
{
HB_SYMBOL_UNUSED( pSym );
/* TODO: pop the proper value */
hb_stackPop(); /* field */
hb_stackPop(); /* alias */
HB_DEBUG( "PopAliasedField\n" );
}
double hb_vmPopDouble( WORD *pwDec )
{
double d;
@@ -1466,6 +1605,14 @@ double hb_vmPopDouble( WORD *pwDec )
return d;
}
static void PopField( PHB_SYMB pSym )
{
HB_SYMBOL_UNUSED( pSym );
/* TODO: pop the proper value */
hb_stackPop();
HB_DEBUG( "PopField\n" );
}
void hb_vmPopLocal( SHORT iLocal )
{
PHB_ITEM pLocal;
@@ -1579,6 +1726,18 @@ void hb_vmPower( void )
hb_vmPushNumber( pow( d1, d2 ), hb_set.HB_SET_DECIMALS );
}
static void PushAliasedField( PHB_SYMB pSym )
{
HB_SYMBOL_UNUSED( pSym );
/* TODO: push the proper value */
stack.pPos->type = IT_INTEGER;
stack.pPos->item.asInteger.value = 0;
stack.pPos->item.asInteger.length = 10;
stack.pPos->item.asInteger.decimal = 0;
hb_stackPush();
HB_DEBUG( "PushAliasedField\n" );
}
void hb_vmPushLogical( BOOL bValue )
{
stack.pPos->type = IT_LOGICAL;
@@ -1587,6 +1746,18 @@ void hb_vmPushLogical( BOOL bValue )
HB_DEBUG( "hb_vmPushLogical\n" );
}
static void PushField( PHB_SYMB pSym )
{
HB_SYMBOL_UNUSED( pSym );
/* TODO: push the proper value */
stack.pPos->type = IT_INTEGER;
stack.pPos->item.asInteger.value = 0;
stack.pPos->item.asInteger.length = 10;
stack.pPos->item.asInteger.decimal = 0;
hb_stackPush();
HB_DEBUG( "PushField\n" );
}
void hb_vmPushLocal( SHORT iLocal )
{
if( iLocal >= 0 )

1
harbour/source/vm/initsymb.c
View File

@@ -9,6 +9,7 @@
#include "hbsetup.h"
#include "extend.h"
#include "hbdefs.h"
#include "init.h"
#include "ctoharb.h"
#include "initsymd.h"

1
harbour/tests/working/Makefile
View File

@@ -150,6 +150,7 @@ PRG_HEADERS=\
test.ch \
BAD_PRG_SOURCES=\
alias.prg \
dupvars.prg \
extend1.prg \
keywords.prg \

133
harbour/tests/working/alias.prg Normal file
View File

@@ -0,0 +1,133 @@
//NOTEST
// $Id$
//
//It is used to check if pcode is generated correctly for aliased expressions
//(you must check it visually :)
//
PROCEDURE MAIN()
LOCAL localVar
STATIC staticVar
FIELD fieldVar
FIELD aliasedField IN aaa
MEMVAR memvarVar
PRIVATE privateVar
? privateVar
? memvarVar
? localVar
? staticVar
? fieldVar
? aliasedField
? unknVar
? 1->privateVar
? 1->memvarVar
? 1->localVar
? 1->staticVar
? 1->fieldVar
? 1->aliasedField
? 1->unknVar
? alias->privateVar
? alias->memvarVar
? alias->localVar
? alias->staticVar
? alias->fieldVar
? alias->aliasedField
? alias->unknVar
? ( localVar )->privateVar
? ( localVar )->memvarVar
? ( localVar )->localVar
? ( localVar )->staticVar
? ( localVar )->fieldVar
? ( localVar )->aliasedField
? ( localVar )->unknVar
? ( localVar )->( privateVar, memvarVar, localVar, staticVar, fieldVar, aliasedField, unknVar )
? alias->( privateVar, memvarVar, localVar, staticVar, fieldVar, aliasedField, unknVar )
? 2->( privateVar, memvarVar, localVar, staticVar, fieldVar, aliasedField, unknVar )
? ( localVar, 2 )->( privateVar, memvarVar, localVar, staticVar, fieldVar, aliasedField, unknVar )
? privateVar++
? memvarVar++
? localVar++
? staticVar++
? fieldVar++
? aliasedField++
? unknVar++
? 1->privateVar++
? 1->memvarVar++
? 1->localVar++
? 1->staticVar++
? 1->fieldVar++
? 1->aliasedField++
? 1->unknVar++
? alias->privateVar++
? alias->memvarVar++
? alias->localVar++
? alias->staticVar++
? alias->fieldVar++
? alias->aliasedField++
? alias->unknVar++
? ( localVar )->privateVar++
? ( localVar )->memvarVar++
? ( localVar )->localVar++
? ( localVar )->staticVar++
? ( localVar )->fieldVar++
? ( localVar )->aliasedField++
? ( localVar )->unknVar++
? privateVar +=privateVar
? memvarVar +=memvarVar
? localVar +=localVar
? staticVar +=staticVar
? fieldVar +=fieldVar
? aliasedField +=aliasedField
? unknVar +=unknVar
? 1->privateVar +=1->privateVar
? 1->memvarVar +=1->memvarVar
? 1->localVar +=1->localVar
? 1->staticVar +=1->staticVar
? 1->fieldVar +=1->fieldVar
? 1->aliasedField +=1->aliasedField
? 1->unknVar +=1->unknVar
? alias->privateVar +=alias->privateVar
? alias->memvarVar +=alias->memvarVar
? alias->localVar +=alias->localVar
? alias->staticVar +=alias->staticVar
? alias->fieldVar +=alias->fieldVar
? alias->aliasedField +=alias->aliasedField
? alias->unknVar +=alias->unknVar
? ( localVar )->privateVar +=( localVar )->privateVar
? ( localVar )->memvarVar +=( localVar )->memvarVar
? ( localVar )->localVar +=( localVar )->localVar
? ( localVar )->staticVar +=( localVar )->staticVar
? ( localVar )->fieldVar +=( localVar )->fieldVar
? ( localVar )->aliasedField +=( localVar )->aliasedField
? ( localVar )->unknVar +=( localVar )->unknVar
? ( localVar )->privateVar +=2->privateVar
? ( localVar )->memvarVar +=2->memvarVar
? ( localVar )->localVar +=2->localVar
? ( localVar )->staticVar +=2->staticVar
? ( localVar )->fieldVar +=2->fieldVar
? ( localVar )->aliasedField +=2->aliasedField
? ( localVar )->unknVar +=2->unknVar
? alias->( aliasedField, MEMVAR->privateVar, 1->(Test( 2->fieldVar )) )
MEMVAR->privateVar :=0
M->localVar :=1
MEMVA->fieldVar :=2
FIELD->fieldVar :=0
FIEL->aliasedFieldVar :=1
RETURN