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

ChangeLog: 19990711-20:25

Browse Source
This commit is contained in:
Ryszard Glab
1999-07-11 19:34:43 +00:00
parent 70ffe0bb1d
commit 4aaed33907
28 changed files with 1082 additions and 480 deletions
Download Patch File Download Diff File Expand all files Collapse all files

75
harbour/ChangeLog
View File

@@ -1,3 +1,78 @@
19990711-20:25 Ryszard Glab <rglab@imid.med.pl>
* include/extend.h
+ added HB_VALUE structure for storing memvars and detached locals
+ added hb_struMemvar used in HB_ITEM structure
* include/hbdefs.h
+ added IT_MEMVAR constant for values stored as memvar reference
+ added IS_MEMVAR macro
* source/vm/hvm.c
* corrected support for detached local variables
+ added support for static variables passed by reference
* variables passed by reference can be now chained and a reference to
static variable can be mixed with a reference to local variable
(this should work for memvar variables too)
* source/rtl/codebloc.c
* corrected support for detached local variables
+ added copyright info
+ source/rtl/memvars.c
+ new file for PUBLIC and PRIVATE variables handling
(it supports detached locals currently)
* source/rtl/classes.c
* updated to use 'ItemUnRef()' function instead of direct stack access
* source/rtl/extend.c
* updated to use 'ItemUnRef()' function instead of direct stack access
* removed all if( pItem->type & IT_BYREF ) and replaced with the *only*
correct if( IS_BYREF(pItem) )
* source/rtl/Makefile
+ added memvars.c file
- tests/working/codebl2.c
- removed this file because its code is now in codebl.prg file
* tests/working/codebl.prg
* added new code to test detached locals (donated by David Pearson)
* tests/working/byref.prg
* added new code to test if Harbour handles variables passed by
reference correctly
* tests/working/Makefile
- removed codebl2.prg
* doc/codebloc.txt
* updated information to reflect current implementation of codeblocks
+ config/win32/bcc32.cf
+ new file for Borland C/C++ Builder
(This file is NOT TESTED yet)
+ config/win32/icc.cf
+ new file for IBM Visual Age C++
(This file is NOT TESTED yet)
* makefile.b16
* makefile.b32
* makefile.icc
* makefile.vc
+ added source/rtl/memvars.c
* makedos.env
* added '-I.' switch for compiler flags
* source/compiler/harbour.l
- removed #include "./harboury.h" (it is now handled by makedos.env)
* source/tools/stringp.prg
* corrected bug in line 101 (':=' should be here instead of '+='
19990710-23:15 Alexander Kresin
* source\hbpp\hbpp.c
* fixed some bugs - now we can use classes.ch

4
harbour/config/dos/watcom.cf
View File

@@ -1,6 +1,8 @@
#
# $Id$
#
# The Harbour project
# GNU MAKE file for Watcom C/C++ 10.x
include $(TOP)$(ROOT)config/$(HB_ARCHITECTURE)/global.cf
@@ -33,7 +35,7 @@ $(COMSPEC) /E:2048 /Cecho $(LINKLIBS) >> __link__.tmp
endef
LD = wlink
LDFLAGS = debug all OP osn=DOS4G OP stack=16384
LDFLAGS = debug all OP osn=DOS4G OP stack=65536
LINKLIBS := LIBP $(subst /,\,$(HB_LIB_DIR)) $(foreach lib, $(LIBS), LIB $(lib))
LD_RULE = $(link_exe_file)

69
harbour/config/win32/bcc32.cf Normal file
View File

@@ -0,0 +1,69 @@
#
# $Id$
#
# The Harbour Project
# GNU MAKE file for Borland C/C++ Builder
#
# This code is NOT TESTED yet! (19990711)
include $(TOP)$(ROOT)config/$(HB_ARCHITECTURE)/global.cf
OBJ_EXT = .obj
EXE_EXT = .exe
LIB_PREF =
LIB_EXT = .lib
$(HB_ARCHITECTURE)_$(HB_COMPILER)_GRANDP = $(subst /,\\,$(GRANDP))
_HB_INC_DIR = $(subst /,\\,$(HB_INC_DIR))
_HL = $(notdir $(HB_LIB_DIR))
ifeq ($(_HL),)
#there is an ending slash
_HB_LIB_DIR = $(subst /,\,$(HB_LIB_DIR))
else
_HB_LIB_DIR = $(subst /,\,$(HB_LIB_DIR)/)
endif
CC = bcc32
CC_IN = -c
CC_OUT = -o
CPPFLAGS = -O2
CFLAGS = -i. -i$(_HB_INC_DIR)
#Note: The empty line below HAVE TO exist!
define link_file
$(COMSPEC) /E:2048 /Cecho $(file) >> __link__.tmp
endef
define link_exe_file
$(COMSPEC) /E:2048 /Cecho $(LDFLAGS) -e$@ > __link__.tmp
$(foreach file, $^, $(link_file))
$(COMSPEC) /E:2048 /Cecho $(LINKLIBS) >> __link__.tmp
-$(LD) @__link__.tmp
endef
LD = bcc32
LDFLAGS = -O2
LINKLIBS = $(foreach lib, $(LIBS), $(_HB_LIB_DIR)$(lib))
LD_RULE = $(link_exe_file)
#Note: The empty line below HAVE TO exist!
define lib_object
echo -+$(file) >> __lib__.tmp
endef
define create_library
echo $@ > __lib__.tmp
$(foreach file, $^, $(lib_object))
$(AR) @__lib__.tmp
del __lib__.tmp
endef
AR = tlib
ARFLAGS =
AR_RULE = $(create_library)
include $(TOP)$(ROOT)config/rules.cf

68
harbour/config/win32/icc.cf Normal file
View File

@@ -0,0 +1,68 @@
#
# $Id$
#
# The Harbour Project
# GNU MAKE file for IBM Visual Age for C++
#
# This code is NOT TESTED yet! (19990711)
include $(TOP)$(ROOT)config/$(HB_ARCHITECTURE)/global.cf
OBJ_EXT = .obj
EXE_EXT = .exe
LIB_PREF =
LIB_EXT = .lib
$(HB_ARCHITECTURE)_$(HB_COMPILER)_GRANDP = $(subst /,\\,$(GRANDP))
_HB_INC_DIR = $(subst /,\\,$(HB_INC_DIR))
_HL = $(notdir $(HB_LIB_DIR))
ifeq ($(_HL),)
#there is an ending slash
_HB_LIB_DIR = $(subst /,\,$(HB_LIB_DIR))
else
_HB_LIB_DIR = $(subst /,\,$(HB_LIB_DIR)/)
endif
CC = icc
CC_IN = /Tp
CC_OUT = /Fo
CPPFLAGS = /C+
CFLAGS = /W2 /Sd /Se+ /Ti+ /i. /i$(_HB_INC_DIR)
#Note: The empty line below HAVE TO exist!
define link_file
echo /fo$(file) >> __link__.tmp
endef
define link_exe_file
echo $(LDFLAGS) -Fe$@ > __link__.tmp
$(foreach file, $^, $(link_file))
echo $(LINKLIBS) >> __link__.tmp
-$(LD) @__link__.tmp
endef
LD = icc
LDFLAGS = $(CFLAGS)
LINKLIBS = $(foreach lib, $(LIBS), $(_HB_LIB_DIR)$(lib))
LD_RULE = $(link_exe_file)
#Note: The empty line below HAVE TO exist!
define lib_object
echo -+$(file) >> __lib__.tmp
endef
define create_library
echo $@ > __lib__.tmp
$(foreach file, $^, $(lib_object))
$(AR) @__lib__.tmp
del __lib__.tmp
endef
AR = ilib
ARFLAGS =
AR_RULE = $(create_library)
include $(TOP)$(ROOT)config/rules.cf

19
harbour/doc/codebloc.txt
View File

@@ -3,7 +3,7 @@ Ryszard Glab <rglab@imid.med.pl>
The compilation of a codeblock.
During compile the codeblock is stored in the following form:
During compile time the codeblock is stored in the following form:
- the header
- the stream of pcode bytes
@@ -29,15 +29,14 @@ the table of local variables positions (copied from the header) is used.
The negative value is used as an index to distinguish it from the reference
to a codeblock parameter. The table of local variables positions is created
during creation of a codeblock (in PushBlock() function).
Detached locals.
If the codeblock is returned from a function and this codeblock refers to
local variables defined in that function then the position of local variable
stored in a codeblock is replaced with the current value of the variable.
In this way the value of local variable can be accessed even outside of the
function where the variable was declared. This proccess is also called
'detaching local variables'
During a codeblock creation, values of all local variables defined in a
procedure and accessed in a codeblock are replaced with a reference to
a value stored in a global memory variables pool. This allows to correct
access for detached local variables in a codeblock returned from this
function either directly (in RETURN statement) or indirectly (by assigning
it to a static or memvar variable). This automatic and unconditional
replace is required because there is no safe method to find if a codeblock
will be accessed from an outside of a function where it is created.
Incompatbility with the Clipper.

53
harbour/include/extend.h
View File

@@ -64,14 +64,21 @@ void ProcessSymbols( SYMBOL *, WORD );
#define IT_MEMO ( IT_MEMOFLAG & IT_STRING )
#define IT_BLOCK 0x1000
#define IT_BYREF 0x2000
#define IT_MEMVAR 0x4000
#define IT_ARRAY 0x8000
#define IT_OBJECT IT_ARRAY
#define IT_NUMERIC ( IT_INTEGER | IT_LONG | IT_DOUBLE )
#define IT_ANY 0xFFFF
struct _HB_CODEBLOCK; /* forward declaration */
struct _HB_BASEARRAY; /* forward declaration */
/* forward declarations
*/
struct _HB_CODEBLOCK;
struct _HB_BASEARRAY;
struct _HB_ITEM;
struct _HB_VALUE;
/* Internal structures that holds data
*/
struct hb_struArray
{
struct _HB_BASEARRAY * value;
@@ -79,7 +86,7 @@ struct hb_struArray
struct hb_struBlock
{
LONG stackbase;
LONG statics;
WORD lineno;
WORD paramcnt;
struct _HB_CODEBLOCK * value;
@@ -118,14 +125,22 @@ struct hb_struLong
long value;
};
struct hb_struMemvar
{
struct _HB_VALUE * *itemsbase;
LONG offset;
LONG value;
};
struct hb_struPointer
{
void *value;
PVOID value;
};
struct hb_struRefer
{
LONG stackbase;
struct _HB_ITEM * *itemsbase;
LONG offset;
LONG value;
};
@@ -143,7 +158,7 @@ struct hb_struSymbol
PSYMBOL value;
};
typedef struct /* items hold at the virtual machine stack */
typedef struct _HB_ITEM /* items hold at the virtual machine stack */
{
WORD type;
union
@@ -155,6 +170,7 @@ typedef struct /* items hold at the virtual machine stack */
struct hb_struInteger asInteger;
struct hb_struLogical asLogical;
struct hb_struLong asLong;
struct hb_struMemvar asMemvar;
struct hb_struPointer asPointer;
struct hb_struRefer asRefer;
struct hb_struString asString;
@@ -162,6 +178,7 @@ typedef struct /* items hold at the virtual machine stack */
} item;
}
HB_ITEM, *PHB_ITEM;
typedef PHB_ITEM HB_ITEM_PTR;
typedef struct _HB_BASEARRAY
{
@@ -196,15 +213,19 @@ typedef struct
typedef struct _HB_CODEBLOCK
{
BYTE * pCode; /* codeblock pcode */
PHB_ITEM pItems; /* table with referenced local variables */
PHB_ITEM pLocals; /* table with referenced local variables */
WORD wLocals; /* number of referenced local variables */
WORD wDetached; /* holds if pItems table variables values */
PSYMBOL pSymbols; /* codeblocks symbols */
WORD wRefBase; /* stack frame position for referenced local variables */
int iStatBase; /* static base for function where CB was created */
long lCounter; /* numer of references to this codeblock */
ULONG lCounter; /* numer of references to this codeblock */
} HB_CODEBLOCK, * HB_CODEBLOCK_PTR;
typedef struct _HB_VALUE
{
HB_ITEM item;
ULONG counter;
PDYNSYM symbol;
} HB_VALUE, * HB_VALUE_PTR;
PHB_ITEM hb_param( int iParam, WORD wType ); /* retrieve a generic parameter */
char * hb_parc( int iParam, ... ); /* retrieve a string parameter */
@@ -232,11 +253,15 @@ void hb_retni( int iNumber ); /* returns a integer number */
void hb_retnl( long lNumber ); /* returns a long number */
void hb_retnd( double dNumber ); /* returns a double */
void hb_reta( ULONG ulLen ); /* returns an array with a specific length */
void * hb_xgrab( ULONG lSize ); /* allocates memory */
void * hb_xrealloc( void * pMem, ULONG lSize ); /* reallocates memory */
void hb_xfree( void * pMem ); /* frees memory */
void ItemCopy( PHB_ITEM pDest, PHB_ITEM pSource );
void ItemRelease( PHB_ITEM pItem );
PHB_ITEM ItemUnRef( PHB_ITEM pItem ); /* de-references passed variable */
void hb_arrayNew( PHB_ITEM pItem, ULONG ulLen ); /* creates a new array */
void hb_arrayGet( PHB_ITEM pArray, ULONG ulIndex, PHB_ITEM pItem ); /* retrieves an item */
ULONG hb_arrayLen( PHB_ITEM pArray ); /* retrives the array len */
@@ -266,4 +291,10 @@ PDYNSYM GetDynSym( char * szName ); /* finds and creates a dynamic symbol if
PDYNSYM NewDynSym( PSYMBOL pSymbol ); /* creates a new dynamic symbol based on a local one */
PDYNSYM FindDynSym( char * szName ); /* finds a dynamic symbol */
/* functions for memvar variables */
HANDLE hb_GlobalValueNew( PHB_ITEM );
void hb_GlobalValueIncRef( HANDLE );
void hb_GlobalValueDecRef( HANDLE );
HB_VALUE_PTR * hb_GlobalValueBaseAddress( void );
#endif /* HB_EXTEND_H_ */

4
harbour/include/hbdefs.h
View File

@@ -43,6 +43,9 @@ typedef int BOOL;
#undef PVOID
typedef void * PVOID;
#undef HANDLE
typedef USHORT HANDLE;
#define LOBYTE(w) ((BYTE)(w))
#define HIBYTE(w) ((BYTE)(((WORD)(w) >> 8) & 0xFF))
#define LOWORD(l) ((WORD)(l))
@@ -87,6 +90,7 @@ typedef HARBOUR ( * HARBOURFUNC )( void );
#define IS_OBJECT( p ) IS_OF_TYPE( p, IT_ARRAY )
#define IS_STRING( p ) IS_OF_TYPE( p, IT_STRING )
#define IS_SYMBOL( p ) IS_OF_TYPE( p, IT_SYMBOL )
#define IS_MEMVAR( p ) IS_OF_TYPE( p, IT_MEMVAR )
#define PCOUNT hb_parinfo( 0 )

28
harbour/include/init.h
View File

@@ -32,7 +32,7 @@ void ProcessSymbols( SYMBOL * pSymbols, WORD wSymbols );
#ifdef HARBOUR_STRICT_ANSI_C
#define HB_INIT_SYMBOLS_BEGIN( func ) \
static SYMBOL symbols[] = {
static SYMBOL symbols[] = {
#define HB_INIT_SYMBOLS_END( func ) }; }; \
void func( void ) \
@@ -50,14 +50,14 @@ static SYMBOL symbols[] = {
static SYMBOL symbols[] = {
#define HB_INIT_SYMBOLS_END( func ) }; \
void __attribute__ ((constructor)) func( void ) \
static void __attribute__ ((constructor)) func( void ) \
{ \
ProcessSymbols( symbols, sizeof( symbols ) / sizeof( SYMBOL ) ); \
}
#define HB_CALL_ON_STARTUP_BEGIN( func ) \
void __attribute__ ((constructor)) func( void ) {
static void __attribute__ ((constructor)) func( void ) {
#define HB_CALL_ON_STARTUP_END( func ) }
#endif
@@ -68,13 +68,13 @@ static SYMBOL symbols[] = {
static SYMBOL symbols[] = {
#define HB_INIT_SYMBOLS_END( func ) }; \
void func( void ) \
static void func( void ) \
{ \
ProcessSymbols( symbols, sizeof( symbols ) / sizeof( SYMBOL ) ); \
}
#define HB_CALL_ON_STARTUP_BEGIN( func ) \
void func( void ) {
static void func( void ) {
#define HB_CALL_ON_STARTUP_END( func ) }
#endif
@@ -84,37 +84,37 @@ static SYMBOL symbols[] = {
static SYMBOL symbols[] = {
#define HB_INIT_SYMBOLS_END( func ) }; \
int func( void ) \
static int func( void ) \
{ \
ProcessSymbols( symbols, sizeof( symbols ) / sizeof( SYMBOL ) ); \
return 1; \
}; \
int static_int_##func = func()
static int static_int_##func = func()
#define HB_CALL_ON_STARTUP_BEGIN( func ) \
int func( void ) {
static int func( void ) {
#define HB_CALL_ON_STARTUP_END( func ) return 1; } \
int static_int_##func = func()
static int static_int_##func = func()
#endif
#ifdef __WATCOMC__
#define HB_INIT_SYMBOLS_BEGIN( func ) \
SYMBOL symbols[] = {
static SYMBOL symbols[] = {
#define HB_INIT_SYMBOLS_END( func ) }; \
int func( void ) \
static int func( void ) \
{ \
ProcessSymbols( symbols, sizeof( symbols ) / sizeof( SYMBOL ) ); \
return 1; \
}; \
int static_int_##func = func()
static int static_int_##func = func()
#define HB_CALL_ON_STARTUP_BEGIN( func ) \
int func( void ) {
static int func( void ) {
#define HB_CALL_ON_STARTUP_END( func ) return 1; }; \
int static_int_##func = func()
static int static_int_##func = func()
#endif
#endif /*HARBOUR_STRICT_ANSI_C */

2
harbour/makedos.env
View File

@@ -16,7 +16,7 @@ HARBOURLIB=$(HARBOURDIR)/libs/libharb.a
# compiler macros for DOS DJGPP
CC=gcc
CFLAGS=-Wall -g -DDEBUG -I$(HARBOURDIR)/include -x c
CFLAGS=-Wall -g -DDEBUG -I. -I$(HARBOURDIR)/include -x c
%.c : %.prg
../../bin/harbour -n -i$(HARBOURDIR)/include $<

3
harbour/makefile.b16
View File

@@ -14,7 +14,7 @@ PROJECT: harbour.lib libs\b16\terminal.lib libs\win16\terminal.lib harbour.exe
harbour.lib : arrays.obj asort.obj classes.obj codebloc.obj dates.obj datesx.obj \
debug.obj descend.obj devoutp.obj dynsym.obj environ.obj error.obj \
errorapi.obj errorsys.obj extend.obj files.obj \
hardcr.obj initsymb.obj itemapi.obj math.obj \
hardcr.obj initsymb.obj itemapi.obj math.obj memvars.obj \
mathx.obj mtran.obj objfunc.obj set.obj stringp.obj strings.obj \
stringsx.obj strcmp.obj tclass.obj transfrm.obj
@@ -49,6 +49,7 @@ initsymb.obj : initsymb.c extend.h hbdefs.h
itemapi.obj : itemapi.c extend.h hbdefs.h
math.obj : math.c extend.h hbdefs.h
mathx.obj : mathx.c extend.h hbdefs.h
memvars.obj : memvars.c extend.h hbdefs.h
mtran.obj : mtran.c extend.h hbdefs.h
objfunc.obj : objfunc.c extend.h hbdefs.h
set.obj : set.c extend.h hbdefs.h

3
harbour/makefile.b31
View File

@@ -18,7 +18,7 @@ harbour.lib : arrays.obj asort.obj classes.obj codebloc.obj copyfile.obj \
dates.obj descend.obj devoutp.obj dir.obj dynsym.obj environ.obj \
error.obj errorapi.obj errorsys.obj extend.obj \
files.obj gtapi.obj hardcr.obj initsymb.obj itemapi.obj \
math.obj mtran.obj msguk.obj objfunc.obj \
math.obj memvars.obj mtran.obj msguk.obj objfunc.obj \
set.obj strings.obj strcmp.obj symbols.obj tclass.obj \
transfrm.obj
@@ -60,6 +60,7 @@ gtapi.obj : gtapi.c extend.h hbdefs.h gtapi.h
hardcr.obj : hardcr.c extend.h hbdefs.h
itemapi.obj : itemapi.c extend.h hbdefs.h ctoharb.h itemapi.h set.h dates.h
math.obj : math.c extend.h hbdefs.h
memvars.obj : memvars.c extend.h hbdefs.h
mtran.obj : mtran.c extend.h hbdefs.h
objfunc.obj : objfunc.prg extend.h hbdefs.h init.h pcode.h
set.obj : set.c extend.h hbdefs.h set.h

3
harbour/makefile.b32
View File

@@ -16,7 +16,7 @@ harbour.lib : arrays.obj asort.obj classes.obj codebloc.obj \
dates.obj datesx.obj debug.obj descend.obj devoutp.obj \
dir.obj dynsym.obj environ.obj error.obj \
errorapi.obj errorsys.obj extend.obj files.obj \
hardcr.obj hb_f.obj initsymb.obj itemapi.obj \
hardcr.obj hb_f.obj initsymb.obj itemapi.obj memvars.obj \
math.obj mathx.obj msguk.obj mtran.obj objfunc.obj set.obj \
symbols.obj strings.obj stringp.obj \
stringsx.obj strcmp.obj tclass.obj transfrm.obj copyfile.obj
@@ -46,6 +46,7 @@ hb_f.obj : hb_f.c extend.h hbdefs.h
initsymb.obj : initsymb.c extend.h hbdefs.h
itemapi.obj : itemapi.c extend.h hbdefs.h
math.obj : math.c extend.h hbdefs.h
memvars.obj : memvars.c extend.h hbdefs.h
mathx.obj : mathx.c extend.h hbdefs.h
msguk.obj : msguk.c extend.h hbdefs.h
mtran.obj : mtran.c extend.h hbdefs.h

2
harbour/makefile.icc
View File

@@ -38,6 +38,7 @@ $(path_lib)\harbour.lib : \
$(path_obj)\initsymb.obj \
$(path_obj)\itemapi.obj \
$(path_obj)\math.obj \
$(path_obj)\memvars.obj \
$(path_obj)\msguk.obj \
$(path_obj)\mtran.obj \
$(path_obj)\objfunc.obj \
@@ -107,6 +108,7 @@ $(path_obj)\io.obj : {$(path_c)}io.c $(path_h)\extend.h $(path_h)\hb
$(path_obj)\initsymb.obj : {$(path_c)}initsymb.c $(path_h)\extend.h $(path_h)\hbdefs.h
$(path_obj)\itemapi.obj : {$(path_c)}itemapi.c $(path_h)\extend.h $(path_h)\hbdefs.h $(path_h)\itemapi.h $(path_h)\set.h $(path_h)\ctoharb.h $(path_h)\dates.h
$(path_obj)\math.obj : {$(path_c)}math.c $(path_h)\extend.h $(path_h)\hbdefs.h $(path_h)\errorapi.h $(path_h)\error.ch
$(path_obj)\memvars.obj : {$(path_c)}memvars.c $(path_h)\extend.h $(path_h)\hbdefs.h
$(path_obj)\mathx.obj : {$(path_c)}mathx.c $(path_h)\extend.h $(path_h)\hbdefs.h
$(path_obj)\mtran.obj : {$(path_c)}mtran.c $(path_h)\extend.h $(path_h)\hbdefs.h
$(path_obj)\set.obj : {$(path_c)}set.c $(path_h)\extend.h $(path_h)\hbdefs.h $(path_h)\set.h $(path_h)\errorapi.h $(path_h)\error.ch

4
harbour/makefile.vc
View File

@@ -68,6 +68,7 @@ HARBOUR_LIB_OBJS = \
$(OBJ_DIR)\initsymb.obj \
$(OBJ_DIR)\itemapi.obj \
$(OBJ_DIR)\math.obj \
$(OBJ_DIR)\memvars.obj \
$(OBJ_DIR)\msguk.obj \
$(OBJ_DIR)\mtran.obj \
$(OBJ_DIR)\objfunc.obj \
@@ -243,6 +244,9 @@ $(OBJ_DIR)\itemapi.obj : $(RTL_DIR)\itemapi.c
$(OBJ_DIR)\math.obj : $(RTL_DIR)\math.c
$(CC) $(CLIBFLAGS) -Fo$@ $**
$(OBJ_DIR)\memvars.obj : $(RTL_DIR)\memvars.c
$(CC) $(CLIBFLAGS) -Fo$@ $**
$(OBJ_DIR)\msguk.obj : $(RTL_DIR)\natmsg\msguk.c
$(CC) $(CLIBFLAGS) -Fo$@ $**

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

@@ -35,11 +35,7 @@
#include <stdlib.h>
#include <string.h>
#include <limits.h>
#if __DJGPP__
#include "./harboury.h"
#else
#include "harboury.h"
#endif
#include "harboury.h"
#include "hbsetup.h" /* main configuration file */
#include "hberrors.h"
#include "hbdefs.h"

1
harbour/source/rtl/Makefile
View File

@@ -22,6 +22,7 @@ C_SOURCES=\
hardcr.c \
itemapi.c \
math.c \
memvars.c \
mtran.c \
set.c \
strcmp.c \

8
harbour/source/rtl/classes.c
View File

@@ -212,13 +212,13 @@ HARBOUR HB_CLASSADD(void)
pClass->wMethods++; /* One more message */
}
else
printf("\nOld %i\n",(long) pNewMeth->pFunction);
printf("\nOld %li\n",(long) pNewMeth->pFunction);
switch( wType )
{
case MET_METHOD:
pNewMeth->pFunction = ( HARBOURFUNC ) hb_parnl( 3 );
printf("\nPointer=%i\n",hb_parnl( 3 ));
printf("\nPointer=%li\n",hb_parnl( 3 ));
break;
case MET_DATA:
@@ -502,7 +502,7 @@ static HARBOUR ClassName( void )
PHB_ITEM pItemRef;
if( IS_BYREF( stack.pBase + 1 ) ) /* Variables by reference */
pItemRef = stack.pItems + ( stack.pBase + 1 )->item.asRefer.value;
pItemRef = ItemUnRef( stack.pBase + 1 );
else
pItemRef = stack.pBase + 1;
@@ -558,7 +558,7 @@ static HARBOUR ClassSel(void)
/* Variables by reference */
if( ( ! wClass ) && IS_BYREF( stack.pBase + 1 ) )
{
pItemRef = stack.pItems + ( stack.pBase + 1 )->item.asRefer.value;
pItemRef = ItemUnRef( stack.pBase + 1 );
if( IS_ARRAY( pItemRef ) )
wClass = pItemRef->item.asArray.value->wClass;
}

256
harbour/source/rtl/codebloc.c
View File

@@ -1,6 +1,37 @@
/*
* $Id$
*/
*
Harbour Project source code
This file is a part of Harbour Runtime Library and it contains code
that handles codeblocks
Copyright (C) 1999 Ryszard Glab
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/).
*/
/* The Harbour implementation of codeblocks */
@@ -18,177 +49,176 @@ extern STACK stack;
/* Creates the codeblock structure
*
* The buffer should contain:
* +0 bytes -> number of referenced local variables
* +2 bytes -> table of referenced local variables
* +2 + 2 *(number of referenced variables) -> codeblock pcode
* pBuffer -> the buffer with pcodes (without HB_P_PUSHBLOCK)
* wLocals -> number of local variables referenced in a codeblock
* pLocalPosTable -> a table with positions on eval stack for referenced variables
* pSymbols -> a pointer to the module symbol table
*
* Note: pLocalPosTable cannot be used if wLocals is ZERO
*
*/
HB_CODEBLOCK_PTR CodeblockNew( BYTE * pBuffer, WORD wSize, PSYMBOL pSymbols,
int iStaticsBase, WORD wStackBase )
HB_CODEBLOCK_PTR hb_CodeblockNew( BYTE * pBuffer,
WORD wLocals,
WORD *pLocalPosTable,
PSYMBOL pSymbols )
{
HB_CODEBLOCK_PTR pCBlock;
WORD wVars;
pCBlock =( HB_CODEBLOCK_PTR ) hb_xgrab( sizeof(HB_CODEBLOCK) );
/* Check the number of referenced local variables
/* Store the number of referenced local variables
*/
wVars = * ( (WORD *) pBuffer );
wSize -= ( wVars + 1 ) * 2;
pBuffer +=2;
pCBlock->wLocals =wVars;
if( wVars )
pCBlock->wLocals =wLocals;
if( wLocals )
{
WORD w = 0;
/* Create the table with references to local variables
* If this codeblock will be exported from a function then
* all references will be replaced with current values of
* these variables
/* NOTE: if a codeblock will be created by macro compiler then
* wLocal have to be ZERO
*/
pCBlock->pItems =(PHB_ITEM) hb_xgrab( sizeof(HB_ITEM) * wVars );
WORD w = 0;
PHB_ITEM pLocal;
HANDLE hGlobal;
while( wVars-- )
/* Create a table that will store the values of local variables
* accessed in a codeblock
*/
pCBlock->pLocals =(PHB_ITEM) hb_xgrab( wLocals * sizeof(HB_ITEM) );
while( wLocals-- )
{
pCBlock->pItems[ w ].type =IT_BYREF; /* not really integer */
pCBlock->pItems[ w ].item.asRefer.value = * ( (WORD*) pBuffer );
/* Swap the current value of local variable with the reference to this
* value.
* TODO: If Harbour will support threads in the future then we need
* to implement some kind of semaphores here.
*/
pLocal =stack.pBase +1 +(*pLocalPosTable++);
if( ! IS_MEMVAR( pLocal ) )
{
/* Change the value only if this variable is not referenced
* by another codeblock yet.
* In this case we have to copy the current value to a global memory
* pool so it can be shared by codeblocks
*/
hGlobal =hb_GlobalValueNew( pLocal );
pLocal->type =IT_BYREF | IT_MEMVAR;
pLocal->item.asMemvar.itemsbase =hb_GlobalValueBaseAddress();
pLocal->item.asMemvar.offset =0;
pLocal->item.asMemvar.value =hGlobal;
hb_GlobalValueIncRef( pLocal->item.asMemvar.value );
memcpy( pCBlock->pLocals + w, pLocal, sizeof(HB_ITEM) );
}
else
{
/* This variable is already detached (by another codeblock)
* - copy the reference to a value
*/
/* Increment the reference counter so this value will not be
* released if other codeblock will be deleted
*/
hb_GlobalValueIncRef( pLocal->item.asMemvar.value );
memcpy( pCBlock->pLocals + w, pLocal, sizeof(HB_ITEM) );
}
++w;
pBuffer +=2;
}
}
else
pCBlock->pItems =NULL;
pCBlock->pLocals =NULL;
/* the codeblock initally contains references to local variables
*/
pCBlock->wDetached =FALSE;
/*
* pcode is stored in static segment now.
* The codeblock pcode is stored in static segment.
* The only allowed operation on a codeblock is evaluating it then
* there is no need to duplicate its pcode -just store the pointer to it
* there is no need to duplicate its pcode - just store the pointer to it
*/
pCBlock->pCode = pBuffer;
pCBlock->pSymbols =pSymbols;
pCBlock->wDetached =FALSE;
pCBlock->lCounter =1;
pCBlock->iStatBase =iStaticsBase;
/*
* wStackBase is stack base of function where the codeblock was defined
* We need it because stack.pBase points to a stack base of EVAL function
* at the time of codeblock evaluation.
*/
pCBlock->wRefBase =wStackBase;
#ifdef CODEBLOCKDEBUG
printf( "codeblock created (%li) %lx\n", pCBlock->lCounter, pCBlock );
printf( "\ncodeblock created (%li) %lx", pCBlock->lCounter, pCBlock );
#endif
return pCBlock;
}
/* Delete a codeblock
*/
void CodeblockDelete( HB_CODEBLOCK_PTR pCBlock )
void hb_CodeblockDelete( HB_ITEM_PTR pItem )
{
HB_CODEBLOCK_PTR pCBlock = pItem->item.asBlock.value;
#ifdef CODEBLOCKDEBUG
printf( "delete a codeblock (%li) %lx\n", pCBlock->lCounter, pCBlock );
printf( "\ndelete a codeblock (%li) %lx", pCBlock->lCounter, pCBlock );
#endif
if( --pCBlock->lCounter == 0 )
{
WORD w = 0;
if( --pCBlock->lCounter == 0 )
{
/* free space allocated for local variables
*/
if( pCBlock->pLocals )
{
WORD w = 0;
while( w < pCBlock->wLocals )
{
hb_GlobalValueDecRef( pCBlock->pLocals[ w ].item.asMemvar.value );
++w;
}
hb_xfree( pCBlock->pLocals );
}
/* free space allocated for local variables
*/
if( pCBlock->pItems )
{
while( w < pCBlock->wLocals )
ItemRelease( &pCBlock->pItems[ w++ ] );
hb_xfree( pCBlock->pItems );
}
/* free space allocated for a CODEBLOCK structure
*/
hb_xfree( pCBlock );
#ifdef CODEBLOCKDEBUG
printf( "codeblock deleted (%li) %lx\n", pCBlock->lCounter, pCBlock );
#endif
}
}
/* Function to unlink variables referenced in a codeblock from a function
* where this codeblock was created
*/
void CodeblockDetach( HB_CODEBLOCK_PTR pCBlock )
{
if( pCBlock->wLocals && !pCBlock->wDetached )
{
/* this codeblock refers to local variables */
WORD w = 0;
PHB_ITEM pItem;
while( w < pCBlock->wLocals )
{
/* replace the position of local variable on the stack with
* it's current value
* stack.pBase still points to a stack frame of function
* where this codeblock was defined
*/
pItem =pCBlock->pItems + w;
pItem =stack.pBase +pItem->item.asRefer.value + 1;
if( IS_BYREF( pItem ) )
pItem =stack.pItems +pItem->item.asRefer.value;
ItemCopy( pCBlock->pItems + w, pItem );
++w;
}
pCBlock->wDetached =TRUE;
}
#ifdef CODEBLOCKDEBUG
printf( "codeblock detached(%li) %lx\n", pCBlock->lCounter, pCBlock );
#endif
/* free space allocated for a CODEBLOCK structure
*/
hb_xfree( pCBlock );
#ifdef CODEBLOCKDEBUG
printf( "\ncodeblock deleted (%li) %lx", pCBlock->lCounter, pCBlock );
#endif
}
}
/* Evaluate passed codeblock
* wStackBase is stack base of function where the codeblock was defined
* We need it because stack.pBase points to a stack base of EVAL function
* Before evaluation we have to switch to a static variable base that
* was defined when the codeblock was created.
* (The codeblock can only see the static variables defined in a module
* where the codeblock was created)
*/
void CodeblockEvaluate( HB_CODEBLOCK_PTR pCBlock )
void hb_CodeblockEvaluate( HB_ITEM_PTR pItem )
{
int iStatics = stack.iStatics;
stack.iStatics = pCBlock->iStatBase;
VirtualMachine( pCBlock->pCode, pCBlock->pSymbols );
stack.iStatics = pItem->item.asBlock.statics;
VirtualMachine( pItem->item.asBlock.value->pCode, pItem->item.asBlock.value->pSymbols );
stack.iStatics = iStatics;
}
/* Get local variable referenced in a codeblock
*/
PHB_ITEM CodeblockGetVar( PHB_ITEM pItem, LONG iItemPos )
PHB_ITEM hb_CodeblockGetVar( PHB_ITEM pItem, LONG iItemPos )
{
HB_CODEBLOCK_PTR pCBlock = pItem->item.asBlock.value;
/* local variables accessed in a codeblock are always stored as reference */
return ItemUnRef( pCBlock->pLocals -iItemPos -1 );
}
/* Get local variable passed by reference
*/
PHB_ITEM hb_CodeblockGetRef( PHB_ITEM pItem, PHB_ITEM pRefer )
{
HB_CODEBLOCK_PTR pCBlock = pItem->item.asBlock.value;
PHB_ITEM pLocalVar;
pLocalVar =&pCBlock->pItems[ -iItemPos -1 ];
/* if a codeblock have detached local variables then it stores their value */
if( !pCBlock->wDetached )
{
/* when variables are not detached then a codeblock stores the variable's
* position on the stack
*/
pLocalVar =stack.pItems +pCBlock->wRefBase +pLocalVar->item.asRefer.value + 1;
}
return pLocalVar;
return pCBlock->pLocals -pRefer->item.asRefer.value -1;
}
/* Copy the codeblock
* TODO: check if such simple pointer coping will allow to evaluate
* codeblocks recursively
*/
void CodeblockCopy( PHB_ITEM pDest, PHB_ITEM pSource )
void hb_CodeblockCopy( PHB_ITEM pDest, PHB_ITEM pSource )
{
pDest->item.asBlock.value =pSource->item.asBlock.value;
pDest->item.asBlock.value->lCounter++;
#ifdef CODEBLOCKDEBUG
printf( "copy a codeblock (%li) %lx\n", pDest->item.asBlock.valuevalue->lCounter, pDest->item.asBlock.valuevalue);
printf( "\ncopy a codeblock (%li) %lx", pSource->item.asBlock.value->lCounter, pSource->item.asBlock.value );
#endif
}

332
harbour/source/rtl/extend.c
View File

@@ -44,28 +44,28 @@ PHB_ITEM hb_param( int iParam, WORD wMask )
if( ( iParam <= hb_pcount() ) || ( iParam == -1 ) )
{
if( iParam == -1 )
wType = stack.Return.type;
wType = stack.Return.type;
else if( iParam < -1 )
return 0;
return 0;
else
wType = ( stack.pBase + 1 + iParam )->type;
wType = ( stack.pBase + 1 + iParam )->type;
if( ( wType & wMask ) || ( wType == IT_NIL && wMask == IT_ANY ) )
{
if( iParam == -1 )
pLocal = &stack.Return;
else if( iParam < -1 )
return 0;
else
pLocal = stack.pBase + 1 + iParam;
if( iParam == -1 )
pLocal = &stack.Return;
else if( iParam < -1 )
return 0;
else
pLocal = stack.pBase + 1 + iParam;
if( wType & IT_BYREF )
return stack.pItems + pLocal->item.asRefer.value;
else
return pLocal;
if( wType & IT_BYREF )
return ItemUnRef( pLocal );
else
return pLocal;
}
else
return 0;
return 0;
}
return 0;
}
@@ -83,27 +83,27 @@ char * hb_parc( int iParam, ... )
if( ( iParam <= hb_pcount() ) || ( iParam == -1 ) )
{
if( iParam == -1 )
pItem = &stack.Return;
pItem = &stack.Return;
else if( iParam < -1 )
return "";
return "";
else
pItem = stack.pBase + 1 + iParam;
pItem = stack.pBase + 1 + iParam;
if( pItem->type & IT_BYREF )
pItem = stack.pItems + pItem->item.asRefer.value;
if( IS_BYREF( pItem ) )
pItem = ItemUnRef( pItem );
if( IS_ARRAY( pItem ) )
{
if( wArrayIndex )
return hb_arrayGetString( pItem, wArrayIndex );
else
return "";
if( wArrayIndex )
return hb_arrayGetString( pItem, wArrayIndex );
else
return "";
}
else if( IS_STRING( pItem ) )
return pItem->item.asString.value;
return pItem->item.asString.value;
else
return "";
return "";
}
return "";
}
@@ -127,8 +127,8 @@ ULONG hb_parclen( int iParam, ... )
else
pItem = stack.pBase + 1 + iParam;
if( pItem->type & IT_BYREF )
pItem = stack.pItems + pItem->item.asRefer.value;
if( IS_BYREF( pItem ) )
pItem = ItemUnRef( pItem );
if( IS_ARRAY( pItem ) )
{
@@ -166,8 +166,8 @@ char * hb_pards( int iParam, ... )
else
pItem = stack.pBase + 1 + iParam;
if( pItem->type & IT_BYREF )
pItem = stack.pItems + pItem->item.asRefer.value;
if( IS_BYREF( pItem ) )
pItem = ItemUnRef( pItem );
if( IS_ARRAY( pItem ) )
{
@@ -175,7 +175,7 @@ char * hb_pards( int iParam, ... )
return strcpy( stack.szDate, hb_arrayGetDate( pItem, wArrayIndex ) );
else
return " ";
}
}
else if( IS_DATE( pItem ) && pItem->item.asDate.value > 0 )
{
@@ -220,8 +220,8 @@ int hb_parl( int iParam, ... )
else
pItem = stack.pBase + 1 + iParam;
if( pItem->type & IT_BYREF )
pItem = stack.pItems + pItem->item.asRefer.value;
if( IS_BYREF( pItem ) )
pItem = ItemUnRef( pItem );
if( IS_ARRAY( pItem ) )
{
@@ -230,7 +230,7 @@ int hb_parl( int iParam, ... )
else
return 0;
}
else if( IS_LOGICAL( pItem ) )
return pItem->item.asLogical.value;
@@ -259,8 +259,8 @@ double hb_parnd( int iParam, ... )
else
pItem = stack.pBase + 1 + iParam;
if( pItem->type & IT_BYREF )
pItem = stack.pItems + pItem->item.asRefer.value;
if( IS_BYREF( pItem ) )
pItem = ItemUnRef( pItem );
if( IS_ARRAY( pItem ) )
{
@@ -303,9 +303,9 @@ int hb_parni( int iParam, ... )
else
pItem = stack.pBase + 1 + iParam;
if( pItem->type & IT_BYREF )
pItem = stack.pItems + pItem->item.asRefer.value;
if( IS_BYREF( pItem ) )
pItem = ItemUnRef( pItem );
if( IS_ARRAY( pItem ) )
{
if( wArrayIndex )
@@ -348,8 +348,8 @@ long hb_parnl( int iParam, ... )
else
pItem = stack.pBase + 1 + iParam;
if( pItem->type & IT_BYREF )
pItem = stack.pItems + pItem->item.asRefer.value;
if( IS_BYREF( pItem ) )
pItem = ItemUnRef( pItem );
if( IS_ARRAY( pItem ) )
{
@@ -526,39 +526,39 @@ void hb_storc( char * szText, int iParam, ... )
{
if( iParam == -1 )
{
pItem = &stack.Return;
ulLen = strlen( szText );
ItemRelease( pItem );
pItem->type = IT_STRING;
pItem->item.asString.length = ulLen;
pItem->item.asString.value = ( char * ) hb_xgrab( ulLen + 1 );
strcpy( pItem->item.asString.value, szText );
pItem = &stack.Return;
ulLen = strlen( szText );
ItemRelease( pItem );
pItem->type = IT_STRING;
pItem->item.asString.length = ulLen;
pItem->item.asString.value = ( char * ) hb_xgrab( ulLen + 1 );
strcpy( pItem->item.asString.value, szText );
}
else if( iParam < -1 )
return;
return;
else
pItem = stack.pBase + 1 + iParam;
pItem = stack.pBase + 1 + iParam;
if( IS_ARRAY( pItem ) && wArrayIndex )
{
ulLen = strlen( szText );
pItemRef = hb_itemNew( NULL );
pItemRef->type = IT_STRING;
pItemRef->item.asString.length = ulLen;
pItemRef->item.asString.value = ( char * ) hb_xgrab( ulLen + 1 );
strcpy( pItemRef->item.asString.value, szText );
hb_arraySet( pItem, wArrayIndex, pItemRef );
hb_itemRelease( pItemRef );
ulLen = strlen( szText );
pItemRef = hb_itemNew( NULL );
pItemRef->type = IT_STRING;
pItemRef->item.asString.length = ulLen;
pItemRef->item.asString.value = ( char * ) hb_xgrab( ulLen + 1 );
strcpy( pItemRef->item.asString.value, szText );
hb_arraySet( pItem, wArrayIndex, pItemRef );
hb_itemRelease( pItemRef );
}
else if( IS_BYREF( pItem ) )
{
ulLen = strlen( szText );
pItemRef = stack.pItems + pItem->item.asRefer.value;
ItemRelease( pItemRef );
pItemRef->type = IT_STRING;
pItemRef->item.asString.length = ulLen;
pItemRef->item.asString.value = ( char * ) hb_xgrab( ulLen + 1 );
strcpy( pItemRef->item.asString.value, szText );
ulLen = strlen( szText );
pItemRef = ItemUnRef( pItem );
ItemRelease( pItemRef );
pItemRef->type = IT_STRING;
pItemRef->item.asString.length = ulLen;
pItemRef->item.asString.value = ( char * ) hb_xgrab( ulLen + 1 );
strcpy( pItemRef->item.asString.value, szText );
}
}
}
@@ -577,39 +577,39 @@ void hb_storclen( char * fixText, WORD wLength, int iParam, ... )
{
if( iParam == -1 )
{
pItem = &stack.Return;
ItemRelease( pItem );
pItem->type = IT_STRING;
pItem->item.asString.length = wLength;
pItem->item.asString.value = ( char * ) hb_xgrab( wLength + 1 );
memcpy( pItem->item.asString.value, fixText, wLength );
pItem->item.asString.value[ wLength ] = '\0';
pItem = &stack.Return;
ItemRelease( pItem );
pItem->type = IT_STRING;
pItem->item.asString.length = wLength;
pItem->item.asString.value = ( char * ) hb_xgrab( wLength + 1 );
memcpy( pItem->item.asString.value, fixText, wLength );
pItem->item.asString.value[ wLength ] = '\0';
}
else if( iParam < -1 )
return;
return;
else
pItem = stack.pBase + 1 + iParam;
pItem = stack.pBase + 1 + iParam;
if( IS_ARRAY( pItem ) && wArrayIndex )
{
pItemRef = hb_itemNew( NULL );
pItemRef->type = IT_STRING;
pItemRef->item.asString.length = wLength;
pItemRef->item.asString.value = ( char * ) hb_xgrab( wLength + 1 );
memcpy( pItemRef->item.asString.value, fixText, wLength );
pItemRef->item.asString.value[ wLength ] = '\0';
hb_arraySet( pItem, wArrayIndex, pItemRef );
hb_itemRelease( pItemRef );
pItemRef = hb_itemNew( NULL );
pItemRef->type = IT_STRING;
pItemRef->item.asString.length = wLength;
pItemRef->item.asString.value = ( char * ) hb_xgrab( wLength + 1 );
memcpy( pItemRef->item.asString.value, fixText, wLength );
pItemRef->item.asString.value[ wLength ] = '\0';
hb_arraySet( pItem, wArrayIndex, pItemRef );
hb_itemRelease( pItemRef );
}
else if( IS_BYREF( pItem ) )
{
pItemRef = stack.pItems + pItem->item.asRefer.value;
ItemRelease( pItemRef );
pItemRef->type = IT_STRING;
pItemRef->item.asString.length = wLength;
pItemRef->item.asString.value = ( char * ) hb_xgrab( wLength + 1 );
memcpy( pItemRef->item.asString.value, fixText, wLength );
pItemRef->item.asString.value[ wLength ] = '\0';
pItemRef = ItemUnRef( pItem );
ItemRelease( pItemRef );
pItemRef->type = IT_STRING;
pItemRef->item.asString.length = wLength;
pItemRef->item.asString.value = ( char * ) hb_xgrab( wLength + 1 );
memcpy( pItemRef->item.asString.value, fixText, wLength );
pItemRef->item.asString.value[ wLength ] = '\0';
}
}
}
@@ -640,33 +640,33 @@ void hb_stords( char * szDate, int iParam, ... ) /* szDate must have yyyymmdd fo
{
if( iParam == -1 )
{
pItem = &stack.Return;
ItemRelease( pItem );
pItem->type = IT_DATE;
pItem->item.asDate.length = 8;
pItem->item.asDate.value = hb_dateEncode( lDay, lMonth, lYear );
pItem = &stack.Return;
ItemRelease( pItem );
pItem->type = IT_DATE;
pItem->item.asDate.length = 8;
pItem->item.asDate.value = hb_dateEncode( lDay, lMonth, lYear );
}
else if( iParam < -1 )
return;
return;
else
pItem = stack.pBase + 1 + iParam;
pItem = stack.pBase + 1 + iParam;
if( IS_ARRAY( pItem ) && wArrayIndex )
{
pItemRef = hb_itemNew( NULL );
pItemRef->type = IT_DATE;
pItemRef->item.asDate.length = 8;
pItemRef->item.asDate.value = hb_dateEncode( lDay, lMonth, lYear );
hb_arraySet( pItem, wArrayIndex, pItemRef );
hb_itemRelease( pItemRef );
pItemRef = hb_itemNew( NULL );
pItemRef->type = IT_DATE;
pItemRef->item.asDate.length = 8;
pItemRef->item.asDate.value = hb_dateEncode( lDay, lMonth, lYear );
hb_arraySet( pItem, wArrayIndex, pItemRef );
hb_itemRelease( pItemRef );
}
else if( IS_BYREF( pItem ) )
{
pItemRef = stack.pItems + pItem->item.asRefer.value;
ItemRelease( pItemRef );
pItemRef->type = IT_DATE;
pItemRef->item.asDate.length = 8;
pItemRef->item.asDate.value = hb_dateEncode( lDay, lMonth, lYear );
pItemRef = ItemUnRef( pItem );
ItemRelease( pItemRef );
pItemRef->type = IT_DATE;
pItemRef->item.asDate.length = 8;
pItemRef->item.asDate.value = hb_dateEncode( lDay, lMonth, lYear );
}
}
}
@@ -698,20 +698,20 @@ void hb_storl( int iLogical, int iParam, ... )
if( IS_ARRAY( pItem ) && wArrayIndex )
{
pItemRef = hb_itemNew( NULL );
pItemRef->type = IT_LOGICAL;
pItemRef->item.asLogical.length = 3;
pItemRef->item.asLogical.value = iLogical;
hb_arraySet( pItem, wArrayIndex, pItemRef );
hb_itemRelease( pItemRef );
pItemRef = hb_itemNew( NULL );
pItemRef->type = IT_LOGICAL;
pItemRef->item.asLogical.length = 3;
pItemRef->item.asLogical.value = iLogical;
hb_arraySet( pItem, wArrayIndex, pItemRef );
hb_itemRelease( pItemRef );
}
else if( IS_BYREF( pItem ) )
{
pItemRef = stack.pItems + pItem->item.asRefer.value;
ItemRelease( pItemRef );
pItemRef->type = IT_LOGICAL;
pItemRef->item.asLogical.length = 3;
pItemRef->item.asLogical.value = iLogical;
pItemRef = ItemUnRef( pItem );
ItemRelease( pItemRef );
pItemRef->type = IT_LOGICAL;
pItemRef->item.asLogical.length = 3;
pItemRef->item.asLogical.value = iLogical;
}
}
}
@@ -730,31 +730,31 @@ void hb_storni( int iValue, int iParam, ... )
{
if( iParam == -1 )
{
pItem = &stack.Return;
ItemRelease( pItem );
pItem->type = IT_INTEGER;
pItem->item.asInteger.length = 10;
pItem->item.asInteger.decimal = 0;
pItem->item.asInteger.value = iValue;
pItem = &stack.Return;
ItemRelease( pItem );
pItem->type = IT_INTEGER;
pItem->item.asInteger.length = 10;
pItem->item.asInteger.decimal = 0;
pItem->item.asInteger.value = iValue;
}
else if( iParam < -1 )
return;
return;
else
pItem = stack.pBase + 1 + iParam;
pItem = stack.pBase + 1 + iParam;
if( IS_ARRAY( pItem ) && wArrayIndex )
{
pItemRef = hb_itemNew( NULL );
pItemRef->type = IT_INTEGER;
pItemRef = hb_itemNew( NULL );
pItemRef->type = IT_INTEGER;
pItemRef->item.asInteger.length = 10;
pItemRef->item.asInteger.decimal = 0;
pItemRef->item.asInteger.value = iValue;
hb_arraySet( pItem, wArrayIndex, pItemRef );
hb_itemRelease( pItemRef );
hb_arraySet( pItem, wArrayIndex, pItemRef );
hb_itemRelease( pItemRef );
}
else if( IS_BYREF( pItem ) )
{
pItemRef = stack.pItems + pItem->item.asRefer.value;
pItemRef = ItemUnRef( pItem );
ItemRelease( pItemRef );
pItemRef->type = IT_INTEGER;
pItemRef->item.asInteger.length = 10;
@@ -778,32 +778,32 @@ void hb_stornl( long lValue, int iParam, ... )
{
if( iParam == -1 )
{
pItem = &stack.Return;
ItemRelease( pItem );
pItem->type = IT_LONG;
pItem->item.asLong.length = 10;
pItem->item.asLong.decimal = 0;
pItem->item.asLong.value = lValue;
pItem = &stack.Return;
ItemRelease( pItem );
pItem->type = IT_LONG;
pItem->item.asLong.length = 10;
pItem->item.asLong.decimal = 0;
pItem->item.asLong.value = lValue;
}
else if( iParam < -1 )
return;
return;
else
pItem = stack.pBase + 1 + iParam;
pItem = stack.pBase + 1 + iParam;
if( IS_ARRAY( pItem ) && wArrayIndex )
{
pItemRef = hb_itemNew( NULL );
pItemRef->type = IT_LONG;
pItemRef = hb_itemNew( NULL );
pItemRef->type = IT_LONG;
pItemRef->item.asLong.length = 10;
pItemRef->item.asLong.decimal = 0;
pItemRef->item.asLong.value = lValue;
hb_arraySet( pItem, wArrayIndex, pItemRef );
hb_itemRelease( pItemRef );
hb_arraySet( pItem, wArrayIndex, pItemRef );
hb_itemRelease( pItemRef );
}
else if( IS_BYREF( pItem ) )
{
pItemRef = stack.pItems + pItem->item.asRefer.value;
ItemRelease( pItemRef );
pItemRef = ItemUnRef( pItem );
ItemRelease( pItemRef );
pItemRef->type = IT_LONG;
pItemRef->item.asLong.length = 10;
pItemRef->item.asLong.decimal = 0;
@@ -826,37 +826,37 @@ void hb_stornd( double dValue, int iParam, ... )
{
if( iParam == -1 )
{
pItem = &stack.Return;
ItemRelease( pItem );
pItem->type = IT_DOUBLE;
if( dValue > 10000000000.0 )
pItem->item.asDouble.length = 20;
else
pItem->item.asDouble.length = 10;
pItem->item.asDouble.decimal = hb_set.HB_SET_DECIMALS;
pItem->item.asDouble.value = dValue;
pItem = &stack.Return;
ItemRelease( pItem );
pItem->type = IT_DOUBLE;
if( dValue > 10000000000.0 )
pItem->item.asDouble.length = 20;
else
pItem->item.asDouble.length = 10;
pItem->item.asDouble.decimal = hb_set.HB_SET_DECIMALS;
pItem->item.asDouble.value = dValue;
}
else if( iParam < -1 )
return;
return;
else
pItem = stack.pBase + 1 + iParam;
pItem = stack.pBase + 1 + iParam;
if( IS_ARRAY( pItem ) && wArrayIndex )
{
pItemRef = hb_itemNew( NULL );
pItemRef->type = IT_DOUBLE;
if( dValue > 10000000000.0 )
pItemRef->item.asDouble.length = 20;
else
pItemRef->item.asDouble.length = 10;
pItemRef->item.asDouble.decimal = hb_set.HB_SET_DECIMALS;
pItemRef->item.asDouble.value = dValue;
hb_arraySet( pItem, wArrayIndex, pItemRef );
hb_itemRelease( pItemRef );
pItemRef = hb_itemNew( NULL );
pItemRef->type = IT_DOUBLE;
if( dValue > 10000000000.0 )
pItemRef->item.asDouble.length = 20;
else
pItemRef->item.asDouble.length = 10;
pItemRef->item.asDouble.decimal = hb_set.HB_SET_DECIMALS;
pItemRef->item.asDouble.value = dValue;
hb_arraySet( pItem, wArrayIndex, pItemRef );
hb_itemRelease( pItemRef );
}
else if( IS_BYREF( pItem ) )
{
pItemRef = stack.pItems + pItem->item.asRefer.value;
pItemRef = ItemUnRef( pItem );
ItemRelease( pItemRef );
pItemRef->type = IT_DOUBLE;
if( dValue > 10000000000.0 )

209
harbour/source/rtl/memvars.c Normal file
View File

@@ -0,0 +1,209 @@
/*
* $Id$
*
Harbour Project source code
This file is a part of Harbour Runtime Library and it contains code
that handles memory variables.
Copyright (C) 1999 Ryszard Glab
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 <extend.h>
#include <string.h>
/* static HB_VALUE_PTR _privateTable = NULL; */
static ULONG _globalTableSize = 0;
static ULONG _globalFirstFree = 0;
static ULONG _globalLastFree = 0;
static ULONG _globalFreeCnt = 0;
static HB_VALUE_PTR _globalTable = NULL;
#define TABLE_INITHB_VALUE 10
#define TABLE_EXPANDHB_VALUE 5
/* Uncomment this to trace codeblocks activity
#define MEMVARDEBUG
*/
void hb_MemvarInit( void )
{
}
void hb_MemvarRelease( void )
{
if( _globalTable )
hb_xfree( _globalTable );
}
HB_VALUE_PTR *hb_GlobalValueBaseAddress( void )
{
return &_globalTable;
}
/*
* This function creates new global value.
*
* pSource = item value that have to be stored or NULL
* pOwner = the name of PUBLIC variable or NULL
*
* Returns:
* handle to variable memory or fails
*
*/
HANDLE hb_GlobalValueNew( HB_ITEM_PTR pSource )
{
HB_VALUE_PTR pValue;
HANDLE hValue;
if( ! _globalTable )
{
_globalTable = (HB_VALUE_PTR) hb_xgrab( sizeof(HB_VALUE) * TABLE_INITHB_VALUE );
_globalTableSize = TABLE_INITHB_VALUE;
_globalFreeCnt = 0;
_globalFirstFree = _globalLastFree = 1;
hValue = 0;
}
else
{
if( _globalFreeCnt )
{
/* There are holes in the table
* Get a first available hole
*/
hValue =_globalFirstFree;
--_globalFreeCnt;
/* Now find the next hole
*/
if( _globalFreeCnt )
{
while( _globalTable[ ++_globalFirstFree ].counter );
}
else
/* No more holes
*/
_globalFirstFree =_globalLastFree;
}
else
{
/* Allocate the value from the end of table
*/
if( _globalFirstFree < _globalTableSize )
{
hValue =_globalFirstFree;
_globalFirstFree = ++_globalLastFree;
}
else
{
/* No more free values in the table - expand the table
*/
hValue = _globalTableSize;
_globalFirstFree =_globalLastFree = _globalTableSize +1;
_globalTableSize += TABLE_EXPANDHB_VALUE;
_globalTable =(HB_VALUE_PTR) hb_xrealloc( _globalTable, sizeof(HB_VALUE) * _globalTableSize );
}
}
}
pValue =_globalTable + hValue;
if( pSource )
memcpy( &pValue->item, pSource, sizeof(HB_ITEM) );
else
pValue->item.type =IT_NIL;
pValue->counter =1;
#ifdef MEMVARDEBUG
printf( "\n>>>>>Global item created with handle =%i", hValue );
#endif
return hValue;
}
/*
* This function increases the number of references to passed global value
*
*/
void hb_GlobalValueIncRef( HANDLE hValue )
{
#ifdef MEMVARDEBUG
if( hValue < 0 || hValue > _globalTableSize )
{
printf( "\nInvalid MEMVAR handle %i (max %li)\n", hValue, _globalTableSize );
exit( 1 );
}
#endif
_globalTable[ hValue ].counter++;
#ifdef MEMVARDEBUG
printf( "\n+++Global item (%i) increment refCounter=%li", hValue, _globalTable[ hValue ].counter );
#endif
}
/*
* This function decreases the number of references to passed global value.
* If it is the last reference then this value is deleted.
*
*/
void hb_GlobalValueDecRef( HANDLE hValue )
{
HB_VALUE_PTR pValue;
#ifdef MEMVARDEBUG
if( hValue < 0 || hValue > _globalTableSize )
{
printf( "\nInvalid MEMVAR handle %i (max %li)\n", hValue, _globalTableSize );
exit( 1 );
}
#endif
pValue =_globalTable + hValue;
#ifdef MEMVARDEBUG
printf( "\n---Global item (%i) decrement refCounter=%li", hValue, pValue->counter-1 );
#endif
if( --pValue->counter == 0 )
{
ItemRelease( &pValue->item );
if( _globalFirstFree > hValue )
_globalFirstFree = hValue;
if( (_globalLastFree - hValue) == 1 )
_globalLastFree =hValue;
if( _globalFirstFree != _globalLastFree )
++_globalFreeCnt;
#ifdef MEMVARDEBUG
printf( "\n<<<<<Global item (%i) deleted", hValue );
#endif
}
}

2
harbour/source/tools/stringp.prg
View File

@@ -98,7 +98,7 @@ function ToChar( xTxt, cSeparator, lDebug )
case cValTxt=="A" // Array
if lDebug
cOut += "{"
cOut := "{"
else
cOut := ""
endif

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

@@ -79,6 +79,7 @@ void GreaterEqual( void ); /* checks if the latest - 1 value is greater than
void Inc( void ); /* increment the latest numeric value on the stack */
void Instring( void ); /* check whether string 1 is contained in string 2 */
void ItemCopy( PHB_ITEM pDest, PHB_ITEM pSource ); /* copies an item to one place to another respecting its containts */
PHB_ITEM ItemUnRef( PHB_ITEM pItem ); /* de-references passed variable */
void Less( void ); /* checks if the latest - 1 value is less than the latest, removes both and leaves result */
void LessEqual( void ); /* checks if the latest - 1 value is less than or equal the latest, removes both and leaves result */
void Line( WORD wLine ); /* keeps track of the currently processed PRG line */
@@ -101,7 +102,7 @@ double PopNumber( void ); /* pops the stack latest value and returns it
void PopStatic( WORD wStatic ); /* pops the stack latest value onto a static */
void Power( void ); /* power the latest two values on the stack, removes them and leaves the result */
void Push( PHB_ITEM pItem ); /* pushes a generic item onto the stack */
void PushBlock( BYTE * pCode, WORD wSize, WORD wParam, PSYMBOL pSymbols ); /* creates a codeblock */
void PushBlock( BYTE * pCode, PSYMBOL pSymbols ); /* creates a codeblock */
void PushDate( LONG lDate ); /* pushes a long date onto the stack */
void PushDouble( double lNumber, WORD wDec ); /* pushes a double number onto the stack */
void PushLocal( SHORT iLocal ); /* pushes the containts of a local onto the stack */
@@ -111,6 +112,7 @@ void PushLong( long lNumber ); /* pushes a long number onto the stack */
void PushNil( void ); /* in this case it places nil at self */
void PushNumber( double dNumber, WORD wDec ); /* pushes a number on to the stack and decides if it is integer, long or double */
void PushStatic( WORD wStatic ); /* pushes the containts of a static onto the stack */
void PushStaticByRef( WORD iLocal ); /* pushes a static by refrence onto the stack */
void PushString( char * szText, ULONG length ); /* pushes a string on to the stack */
void PushSymbol( PSYMBOL pSym ); /* pushes a function pointer onto the stack */
void PushInteger( int iNumber ); /* pushes a integer number onto the stack */
@@ -140,12 +142,16 @@ void StackPush( void ); /* pushes an item on to the stack */
void StackInit( void ); /* initializes the stack */
void StackShow( void ); /* show the types of the items on the stack for debugging purposes */
HB_CODEBLOCK_PTR CodeblockNew( BYTE *, WORD, PSYMBOL, int, WORD );
void CodeblockDelete( HB_CODEBLOCK_PTR );
PHB_ITEM CodeblockGetVar( PHB_ITEM, LONG );
void CodeblockEvaluate( HB_CODEBLOCK_PTR );
void CodeblockCopy( PHB_ITEM, PHB_ITEM );
void CodeblockDetach( HB_CODEBLOCK_PTR );
HB_CODEBLOCK_PTR hb_CodeblockNew( BYTE *, WORD, WORD *, PSYMBOL );
void hb_CodeblockDelete( PHB_ITEM );
PHB_ITEM hb_CodeblockGetVar( PHB_ITEM, LONG );
PHB_ITEM hb_CodeblockGetRef( PHB_ITEM, PHB_ITEM );
void hb_CodeblockEvaluate( PHB_ITEM );
void hb_CodeblockCopy( PHB_ITEM, PHB_ITEM );
/* Initialisation and closing memvars subsystem */
void hb_MemvarInit( void );
void hb_MemvarRelease( void );
void InitSymbolTable( void ); /* initialization of runtime support symbols */
@@ -179,8 +185,9 @@ extern POBJSYMBOLS HB_FIRSTSYMBOL, HB_LASTSYMBOL;
#endif
#endif
STACK stack;
int iHB_DEBUG = 0; /* if 1 traces the virtual machine activity */
STACK stack;
SYMBOL symEval = { "__EVAL", FS_PUBLIC, DoBlock, 0 }; /* symbol to evaluate codeblocks */
PSYMBOL pSymStart; /* start symbol of the application. MAIN() is not required */
HB_ITEM aStatics; /* Harbour array to hold all application statics variables */
@@ -216,6 +223,7 @@ BYTE bErrorLevel = 0; /* application exit errorlevel */
StackInit();
NewDynSym( &symEval ); /* initialize dynamic symbol for evaluating codeblocks */
hb_setInitialize(); /* initialize Sets */
hb_MemvarInit();
/* InitializeConsole(); initialize Console */
#ifdef HARBOUR_OBJ_GENERATION
ProcessObjSymbols(); /* initialize Harbour generated OBJs symbols */
@@ -257,6 +265,7 @@ BYTE bErrorLevel = 0; /* application exit errorlevel */
ReleaseLocalSymbols(); /* releases the local modules linked list */
ReleaseDynamicSymbols(); /* releases the dynamic symbol table */
hb_setRelease(); /* releases Sets */
hb_MemvarRelease();
StackFree();
/* LogSymbols(); */
HB_DEBUG( "Done!\n" );
@@ -476,11 +485,6 @@ void VirtualMachine( PBYTE pCode, PSYMBOL pSymbols )
w++;
break;
case HB_P_POPDEFSTAT:
PopDefStat( pCode[ w + 1 ] + ( pCode[ w + 2 ] * 256 ) );
w += 3;
break;
case HB_P_POPLOCAL:
PopLocal( pCode[ w + 1 ] + ( pCode[ w + 2 ] * 256 ) );
w += 3;
@@ -503,12 +507,8 @@ void VirtualMachine( PBYTE pCode, PSYMBOL pSymbols )
* +5 +6 -> number of referenced local variables
* +7 -> start of table with referenced local variables
*/
wSize = pCode[ w + 1 ] + ( pCode[ w + 2 ] * 256 );
PushBlock( pCode + w + 5,
wSize - 5,
pCode[ w + 3 ] + ( pCode[ w + 4 ] * 256 ),
pSymbols );
w += wSize;
PushBlock( pCode + w, pSymbols );
w += (pCode[ w + 1 ] + ( pCode[ w + 2 ] * 256 ));
break;
case HB_P_PUSHDOUBLE:
@@ -551,6 +551,11 @@ void VirtualMachine( PBYTE pCode, PSYMBOL pSymbols )
w += 3;
break;
case HB_P_PUSHSTATICREF:
PushStaticByRef( pCode[ w + 1 ] + ( pCode[ w + 2 ] * 256 ) );
w += 3;
break;
case HB_P_PUSHSTR:
wSize =*( (WORD *) &( pCode[ w + 1 ] ) );
PushString( (char*)pCode + w + 3, wSize );
@@ -779,7 +784,7 @@ HARBOUR DoBlock( void )
*/
stack.pBase->item.asSymbol.lineno =pBlock->item.asBlock.lineno;
CodeblockEvaluate( pBlock->item.asBlock.value );
hb_CodeblockEvaluate( pBlock );
/* restore stack pointers */
stack.pBase = stack.pItems + wStackBase;
@@ -1101,8 +1106,11 @@ void ItemRelease( PHB_ITEM pItem )
}
else if( IS_BLOCK( pItem ) )
{
CodeblockDelete( pItem->item.asBlock.value );
hb_CodeblockDelete( pItem );
}
else if( IS_MEMVAR( pItem ) )
hb_GlobalValueDecRef( pItem->item.asMemvar.value );
pItem->type = IT_NIL;
}
@@ -1154,10 +1162,48 @@ void ItemCopy( PHB_ITEM pDest, PHB_ITEM pSource )
else if( IS_BLOCK( pSource ) )
{
CodeblockCopy( pDest, pSource );
hb_CodeblockCopy( pDest, pSource );
}
else if( IS_MEMVAR( pSource ) )
{
hb_GlobalValueIncRef( pSource->item.asMemvar.value );
}
}
/* De-references item passed by the reference
*
*/
PHB_ITEM ItemUnRef( PHB_ITEM pItem )
{
while( IS_BYREF( pItem ) )
{
if( IS_MEMVAR( pItem ) )
{
HB_VALUE_PTR pValue;
pValue =*(pItem->item.asMemvar.itemsbase) + pItem->item.asMemvar.offset +
pItem->item.asMemvar.value;
pItem =&pValue->item;
}
else
{
if( pItem->item.asRefer.value >= 0 )
pItem =*(pItem->item.asRefer.itemsbase) + pItem->item.asRefer.offset +
pItem->item.asRefer.value;
else
{
/* local variable referenced in a codeblock
*/
pItem =hb_CodeblockGetRef( *(pItem->item.asRefer.itemsbase) + pItem->item.asRefer.offset,
pItem );
}
}
}
return pItem;
}
void Less( void )
{
double dNumber1, dNumber2;
@@ -1469,6 +1515,9 @@ void Plus( void )
else if( IS_OBJECT( pItem1 ) && hb_isMessage( pItem2, "+" ) )
OperatorCall( pItem1, pItem2, "+" );
else
hb_errorRT_BASE( 1081, 1081, "Types of arguments do not match", "+" );
/* TODO: Generate an error if types don't match */
HB_DEBUG( "Plus\n" );
}
@@ -1487,27 +1536,6 @@ long PopDate( void )
}
}
void PopDefStat( WORD wStatic ) /* Pops a default value to a STATIC */
{
PHB_ITEM pStatic;
StackPop();
pStatic = aStatics.item.asArray.value->pItems + stack.iStatics +
wStatic - 1;
if( IS_BYREF( pStatic ) )
{
if( ( stack.pItems + pStatic->item.asRefer.value )->type == IT_NIL )
/* Only initialize when NIL */
ItemCopy( stack.pItems + pStatic->item.asRefer.value, stack.pPos );
}
else
if( pStatic->type == IT_NIL ) /* Only initialize when NIL */
ItemCopy( pStatic, stack.pPos );
ItemRelease( stack.pPos );
HB_DEBUG( "PopDefStat\n" );
}
double PopDouble( WORD *pwDec )
{
@@ -1552,19 +1580,15 @@ void PopLocal( SHORT iLocal )
/* local variable or local parameter */
pLocal = stack.pBase + 1 + iLocal;
if( IS_BYREF( pLocal ) )
{
if( pLocal->item.asRefer.value >= 0)
ItemCopy( stack.pItems + pLocal->item.asRefer.value, stack.pPos );
else
/* local variable referenced in a codeblock */
ItemCopy( CodeblockGetVar( stack.pItems +pLocal->item.asRefer.stackbase +1, pLocal->item.asRefer.value ), stack.pPos );
}
ItemCopy( ItemUnRef( pLocal ), stack.pPos );
else
ItemCopy( pLocal, stack.pPos );
ItemCopy( pLocal, stack.pPos );
}
else
/* local variable referenced in a codeblock */
ItemCopy( CodeblockGetVar( stack.pBase + 1, iLocal ), stack.pPos );
/* local variable referenced in a codeblock
* stack.pBase+1 points to a codeblock that is currently evaluated
*/
ItemCopy( hb_CodeblockGetVar( stack.pBase + 1, iLocal ), stack.pPos );
ItemRelease( stack.pPos );
HB_DEBUG( "PopLocal\n" );
@@ -1622,11 +1646,10 @@ void PopStatic( WORD wStatic )
PHB_ITEM pStatic;
StackPop();
pStatic = aStatics.item.asArray.value->pItems + stack.iStatics +
wStatic - 1;
pStatic = aStatics.item.asArray.value->pItems + stack.iStatics + wStatic - 1;
if( IS_BYREF( pStatic ) )
ItemCopy( stack.pItems + pStatic->item.asRefer.value, stack.pPos );
ItemCopy( ItemUnRef( pStatic ), stack.pPos );
else
ItemCopy( pStatic, stack.pPos );
@@ -1654,26 +1677,23 @@ void PushLogical( int iTrueFalse )
void PushLocal( SHORT iLocal )
{
PHB_ITEM pLocal;
if( iLocal >= 0 )
{
PHB_ITEM pLocal;
/* local variable or local parameter */
pLocal = stack.pBase + 1 + iLocal;
if( IS_BYREF( pLocal ) )
{
if( pLocal->item.asRefer.value >= 0 )
ItemCopy( stack.pPos, stack.pItems + pLocal->item.asRefer.value );
else
/* local variable referenced in a codeblock */
ItemCopy( stack.pPos, CodeblockGetVar( stack.pItems + pLocal->item.asRefer.stackbase +1, pLocal->item.asRefer.value) );
}
ItemCopy( stack.pPos, ItemUnRef( pLocal ) );
else
ItemCopy( stack.pPos, pLocal );
}
else
/* local variable referenced in a codeblock */
ItemCopy( stack.pPos, CodeblockGetVar( stack.pBase + 1, (LONG)iLocal ) );
/* local variable referenced in a codeblock
* stack.pBase+1 points to a codeblock that is currently evaluated
*/
ItemCopy( stack.pPos, hb_CodeblockGetVar( stack.pBase + 1, (LONG)iLocal ) );
StackPush();
HB_DEBUG2( "PushLocal %i\n", iLocal );
}
@@ -1683,16 +1703,9 @@ void PushLocalByRef( SHORT iLocal )
ItemRelease( stack.pPos );
stack.pPos->type = IT_BYREF;
/* we store its stack offset instead of a pointer to support a dynamic stack */
if( iLocal >= 0 )
/* local variable or local parameter */
/* store the position of referenced local variable on the eval stack */
stack.pPos->item.asRefer.value = stack.pBase + 1 + iLocal - stack.pItems;
else
{
/* local variable referenced in a codeblock */
stack.pPos->item.asRefer.value = iLocal;
stack.pPos->item.asRefer.stackbase = stack.pBase - stack.pItems;
}
stack.pPos->item.asRefer.value = iLocal;
stack.pPos->item.asRefer.offset = stack.pBase - stack.pItems +1;
stack.pPos->item.asRefer.itemsbase = &stack.pItems;
StackPush();
HB_DEBUG2( "PushLocalByRef %i\n", iLocal );
@@ -1722,12 +1735,30 @@ void PushNumber( double dNumber, WORD wDec )
void PushStatic( WORD wStatic )
{
ItemCopy( stack.pPos, aStatics.item.asArray.value->pItems +
stack.iStatics + wStatic - 1 );
PHB_ITEM pStatic;
pStatic = aStatics.item.asArray.value->pItems + stack.iStatics + wStatic - 1;
if( IS_BYREF(pStatic) )
ItemCopy( stack.pPos, ItemUnRef(pStatic) );
else
ItemCopy( stack.pPos, pStatic );
StackPush();
HB_DEBUG2( "PushStatic %i\n", wStatic );
}
void PushStaticByRef( WORD wStatic )
{
ItemRelease( stack.pPos );
stack.pPos->type = IT_BYREF;
/* we store the offset instead of a pointer to support a dynamic stack */
stack.pPos->item.asRefer.value = wStatic -1;
stack.pPos->item.asRefer.offset = stack.iStatics;
stack.pPos->item.asRefer.itemsbase = &aStatics.item.asArray.value->pItems;
StackPush();
HB_DEBUG2( "PushStaticByRef %i\n", wStatic );
}
void PushString( char * szText, ULONG length )
{
char * szTemp = ( char * ) hb_xgrab( length + 1 );
@@ -1760,18 +1791,35 @@ void Push( PHB_ITEM pItem )
HB_DEBUG( "Push\n" );
}
void PushBlock( BYTE * pCode, WORD wSize, WORD wParam, PSYMBOL pSymbols )
/* +0 -> HB_P_PUSHBLOCK
* +1 +2 -> size of codeblock
* +3 +4 -> number of expected parameters
* +5 +6 -> number of referenced local variables
* +7 -> start of table with referenced local variables
*/
void PushBlock( BYTE * pCode, PSYMBOL pSymbols )
{
WORD wLocals;
ItemRelease( stack.pPos );
stack.pPos->type = IT_BLOCK;
stack.pPos->item.asBlock.value = CodeblockNew( pCode, wSize, pSymbols,
stack.iStatics, stack.pBase - stack.pItems );
/* store the stack base of function where the codeblock was defined */
stack.pPos->item.asBlock.stackbase = stack.pBase - stack.pItems;
/* store the number of expected parameters */
stack.pPos->item.asBlock.paramcnt = wParam;
/* store the line number where the codeblock was defined */
stack.pPos->item.asBlock.lineno = stack.pBase->item.asSymbol.lineno;
wLocals =pCode[ 5 ] + ( pCode[ 6 ] * 256 );
stack.pPos->item.asBlock.value =
hb_CodeblockNew( pCode + 7 + wLocals*2, /* pcode buffer */
wLocals, /* number of referenced local variables */
(WORD *)(pCode +7), /* table with referenced local variables */
pSymbols );
/* store the statics base of function where the codeblock was defined
*/
stack.pPos->item.asBlock.statics = stack.iStatics;
/* store the number of expected parameters
*/
stack.pPos->item.asBlock.paramcnt = pCode[ 3 ] + ( pCode[ 4 ] * 256 );
/* store the line number where the codeblock was defined
*/
stack.pPos->item.asBlock.lineno = stack.pBase->item.asSymbol.lineno;
StackPush();
HB_DEBUG( "PushBlock\n" );
}
@@ -1823,8 +1871,6 @@ void RetValue( void )
{
StackPop();
ItemCopy( &stack.Return, stack.pPos );
if( stack.Return.type == IT_BLOCK )
CodeblockDetach( stack.Return.item.asBlock.value );
HB_DEBUG( "RetValue\n" );
}

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

@@ -153,6 +153,7 @@ void InitSymbolTable( void )
/*
* The symbol tables from runtime support modules start here
*/
#ifdef HARBOUR_STRICT_ANSI_C
Arrays__InitSymbols();
Classes__InitSymbols();
Console__InitSymbols();
@@ -170,6 +171,7 @@ void InitSymbolTable( void )
Strings__InitInfinity();
#endif
Transfrm__InitSymbols();
#endif
/*
* The system symbol table with runtime functions HAVE TO be called last

26
harbour/tests/broken/cbtest.prg
View File

@@ -1,26 +0,0 @@
Function Main()
Local a := TestBlocks()
qout( eval( a[ 1 ] ) ) // 23
qout( eval( a[ 2 ], 42 ) ) // 42
qout( eval( a[ 1 ] ) ) // 42
qout( eval( a[ 2 ], 15 ) ) // 15
mqout( 15, eval( a[ 1 ] ) ) // 15 15
mqout( 14, eval( a[ 1 ] ) ) // 14 15
mqout( 42, eval( a[ 2 ], 42 ) ) // 42 42
mqout( 14, eval( a[ 2 ], 42 ) ) // 14 42
mqout( 42, eval( a[ 1 ] ) ) // 42 42
mqout( 14, eval( a[ 1 ] ) ) // 14 42
Return( NIL )
Static Function TestBlocks()
Local nFoo := 23
Return( { {|| nFoo }, {|n| nFoo := n } } )
Static Function mqout( nExpected, nGot )
qout( nExpected, nGot )
Return( NIL )

1
harbour/tests/working/Makefile
View File

@@ -20,7 +20,6 @@ PRG_SOURCES=\
classes.prg \
cmphello.prg \
codebl.prg \
codebl2.prg \
codebloc.prg \
comments.prg \
dates.prg \

45
harbour/tests/working/byref.prg
View File

@@ -1,20 +1,55 @@
// Managing variables by reference
function Main()
STATIC s:=10
local x := 0
QOut( "Managing variables by reference" )
QOut( "Managing LOCAL variables by reference" )
Qout( 'In main before ref1 x=', x )
ref1( @x )
Qout( ' In main after ref1 x=', x )
ref( @x )
QOut( x )
QOut( "Managing STATIC variables by reference" )
Qout( 'In main before ref1 s=', s )
ref1( @s )
Qout( ' In main after ref1 s=', s )
return nil
function ref( x )
function ref1( x )
x := 999
x++
Qout( ' In ref1 before ref2 =', x )
Ref2( @x )
Qout( ' In ref1 after ref2 =', x )
return nil
function ref2( x )
x++
Qout( ' In ref2 before ref3 =', x )
Ref3( @x )
Qout( ' In ref2 after ref3 =', x )
return nil
function ref3( x )
STATIC a
x++
Qout( ' In ref3 before ref4 =', x )
a ={ x, x }
Ref4( @a )
Qout( ' In ref3 after ref4 =', x )
return nil
function ref4( a )
a[ 1 ]++
Qout( ' In ref4 =', a[ 1 ] )
return nil

83
harbour/tests/working/codebl.prg
View File

@@ -1,4 +1,78 @@
STATIC cbStatic
Function Main()
Local a := TestBlocks()
LOCAL cb
qout( eval( a[ 1 ] ) ) // 23
qout( eval( a[ 2 ], 42 ) ) // 42
qout( eval( a[ 1 ] ) ) // 42
qout( eval( a[ 2 ], 15 ) ) // 15
mqout( 15, eval( a[ 1 ] ) ) // 15 15
mqout( 14, eval( a[ 1 ] ) ) // 14 15
mqout( 42, eval( a[ 2 ], 42 ) ) // 42 42
mqout( 14, eval( a[ 2 ], 42 ) ) // 14 42
mqout( 42, eval( a[ 1 ] ) ) // 42 42
mqout( 14, eval( a[ 1 ] ) ) // 14 42
GetArray( @a )
PrintArray( @a )
qout( "Test for variables passed by reference in a codeblock" )
DetachWithRefer()
qout( "Test for indirect detaching of local variables" )
DetachToStatic( 1 )
mqout( 2, EVAL( cbStatic, 1 ) )
mqout( 3, EVAL( cbStatic, 2 ) )
cb :=cbStatic
DetachToStatic( 100 )
mqout( 200, EVAL( cbStatic, 100 ) )
mqout( 300, EVAL( cbStatic, 200 ) )
mqout( 4, EVAL( cb, 3 ) )
Return( NIL )
Static Function TestBlocks()
LOCAL nFoo := 23
Return( { {|| nFoo }, {|n| nFoo := n } } )
Static Function mqout( nExpected, nGot )
qout( nExpected, nGot )
Return( NIL )
/////////////////////////////////////////////////////////////////
PROCEDURE GetArray( a )
LOCAL i
a :=ARRAY( 100 )
FOR i:=1 TO 100
IF( (i % 6) == 0 )
a[ i-2 ] =NIL
a[ i-4 ] =NIL
ENDIF
a[ i ] := TestBlocks()
NEXT
RETURN
PROCEDURE PrintArray( a )
LOCAL i
FOR i:=1 TO 100
IF( a[i] != NIL )
EVAL( a[ i ][ 2 ], i )
mqout( i, EVAL( a[ i ][ 1 ] ) )
ENDIF
NEXT
RETURN
//////////////////////////////////////////////////////////////////
Function DetachWithRefer()
Local nTest
Local bBlock1 := MakeBlock()
Local bBlock2 := {|| DoThing( @nTest ), qout( nTest ) }
@@ -10,10 +84,17 @@ Return( NIL )
Function MakeBlock()
Local nTest
Return( {|| DoThing( @nTest ), qout( nTest ) } )
RETURN( {|| DoThing( @nTest ), qout( nTest ) } )
Function DoThing( n )
n := 42
Return( NIL )
//////////////////////////////////////////////////////////////////////
FUNCTION DetachToStatic( n )
cbStatic ={|x| n+x}
RETURN NIL

28
harbour/tests/working/codebl2.prg
View File

@@ -1,28 +0,0 @@
FUNCTION MAIN()
LOCAL a, b, c
c =2
b =Detach( 5, @c )
OUTSTD( EVAL( b, 6, 1 ) )
QOUT("")
b =Detach( c, 15 )
OUTSTD( EVAL( b, 8 ) )
QOUT("")
b =Call1( b )
QOUT( EVAL( b, 10 ) )
RETURN nil
FUNCTION Detach( x, y )
RETURN( {|z| OutStd("z="),OutStd(z), OutStd(" x="),OutStd(x), OutStd(" y="),Outstd(y), Outstd(" z*y+x="), z*x+y} )
FUNCTION Call1( cb )
RETURN( Call2( cb ) )
FUNCTION Call2( cb )
RETURN( Call3( cb ) )
FUNCTION Call3( cb )
RETURN( {|x| EVAL(cb,2) *x} )