* harbour/harbour.spec
* harbour/make_bsd.sh
* harbour/make_drw.sh
* harbour/make_gnu.sh
* harbour/make_rpm.sh
* harbour/make_tgz.sh
* harbour/bin/hb-func.sh
* harbour/bin/pack_src.sh
* harbour/config/c.cf
* harbour/config/global.cf
* harbour/config/rules.cf
* harbour/config/darwin/gcc.cf
* harbour/config/darwin/global.cf
* harbour/config/dos/djgpp.cf
* harbour/config/dos/global.cf
* harbour/config/dos/install.cf
* harbour/config/dos/owatcom.cf
* harbour/config/hpux/gcc.cf
* harbour/config/hpux/global.cf
* harbour/config/linux/gcc.cf
* harbour/config/linux/global.cf
* harbour/config/linux/owatcom.cf
* harbour/config/sunos/gcc.cf
* harbour/config/w32/watcom.cf
* include ADSRDD by default in RPMs
* updated for new RPM which does not accept some old tags
* set -fPIC on 64bit platforms
+ added /etc/harbour/hb-charmap.def
* updated for new GT system and drivers
* harbour/contrib/dot/pp.prg
* harbour/contrib/dot/pp_harb.ch
* use _APMAIN as startup function
* cleaned direct access to item internals
* harbour/contrib/libct/Makefile
+ harbour/contrib/libct/ctwfunc.c
+ harbour/contrib/libct/ctwin.c
+ harbour/contrib/libct/ctwin.h
* added CT3 like Window System - it's a GT driver which inherits
from the existing one and adds CTW functionality
* harbour/contrib/libct/screen1.c
* updated for GTAPI modifications
* harbour/contrib/libnf/Makefile
* harbour/contrib/libnf/chdir.c
* harbour/contrib/libnf/mkdir.c
* harbour/contrib/libnf/rmdir.c
* use hb_fs*() API functions instead of calling DOS interrupts
Now NF dir functions works on all platforms - it will be nice
to update other functions too.
* harbour/contrib/libnf/dispc.c
* harbour/contrib/libnf/ftattr.c
* updated for GT API modifications, some of this code still depends
on EGA/VGA video buffer so will work only if user will force in GT
using it - it will be nice to rewrite them
* harbour/contrib/odbc/odbc.c
* harbour/contrib/ole/ole2.c
* casting and cleaning direct access to item internals
* harbour/contrib/rdd_ads/ads1.c
* harbour/contrib/rdd_ads/adsfunc.c
* harbour/contrib/rdd_ads/adsmgmnt.c
* synced with xHarbour
* harbour/include/Makefile
* added new header files
+ harbour/include/hbgtinfo.ch
+ added GTI_* defintions for hb_gtInfo() function.
This function works in similar way to dbInfo() in RDD.
The GTI_* definitions are taken from xHarbour "as is" and
they should be cleaned - not all functionality are supported
in Harbour and some others should be implemented in differ
way then in xHarbour.
+ harbour/include/hbgtcore.h
* harbour/include/hbapigt.h
* new GTAPI
hbgtcore.h file should not be included by user code
it's only for internal use in GT drivers
* HB_inkey_enum changed to int - this is bit field not enumerated type.
Many of C/C++ compilers forbid bit operations on enum types and
forcing it by casting which finally exceeds the enum range is defined
as bug because it may badly interacts with some compiler optimizations
* harbour/include/hbapi.h
* harbour/include/hbapicdp.h
* harbour/include/hbapierr.h
* harbour/include/hbapifs.h
* harbour/include/hbapiitm.h
* harbour/include/hbapilng.h
* harbour/include/hbapirdd.h
* harbour/include/hbdate.h
* harbour/include/hbdefs.h
* harbour/include/hbinit.h
* harbour/include/hbpcode.h
* harbour/include/hbrdddbf.h
* harbour/include/hbset.h
* harbour/include/hbstack.h
* harbour/include/hbvm.h
* harbour/include/hbvmopt.h
* harbour/include/hbvmpub.h
* separated internal and external API. Now the definitions for
internal HVM structures and functions are excluded by default
they could be enabled if user include hbvmopt.h before other
header files. Such operation should be done _ONLY_ by core
code - if 3-rd party developers make sth like that then it's
for their own risk and such code may stop to work with next
Harbour versions. Without hbvmopt.h the internal structures
like HB_ITEM, HB_DYNS, ... are mapped to 'void' so there is
no way to access their members so we can modify them in the
future without afford for 3-rd party code.
There is one small exception 'type' should be the first member
for HB_ITEM structure because I used a small ugly hack in
HB_IS_*() macros with castin PHB_ITEM to HB_TYPE* - it works
without speed overhead but if you think that it will be
better/cleaner to not use such tricks then it's enough to
change HB_ITEM_TYPE() definitions in hbvmpub.h - see note.
* cleared the usage of HB_EXPORT - to avoid problems with some C/C++
compilers we agreed that the only one common way of using HB_EXPORT
is adding it ad begining of declaration - please keep this convention
in the future.
+ added new functions:
hb_extIsObject(), hb_codeblockId(), hb_idleSleep(),
hb_fsGetOsHandle(),
hb_dynsymFindSymbol(), hb_dynsymGetSymbol(),
hb_dynsymSymbol(), hb_dynsymName(),
hb_dynsymMemvarHandle(), hb_dynsymAreaHandle(), hb_dynsymSetAreaHandle()
* changed hb_arrayClone() declaration to:
PHB_ITEM hb_arrayClone( PHB_ITEM pArray )
* changed hb_arrayFromParams() declaration to:
PHB_ITEM hb_arrayFromParams( int iLevel )
The previous version needed a pointer to stack relocatable area
so any stack resizing could cause GPF.
* harbour/include/inkey.ch
* added definitions for extended mouse keys/events and some key
combinations
* harbour/source/codepage/uc1250.c
* harbour/source/codepage/uc1251.c
* harbour/source/codepage/uc1253.c
* harbour/source/codepage/uc1257.c
* harbour/source/codepage/uc737.c
* harbour/source/codepage/uc850.c
* harbour/source/codepage/uc852.c
* harbour/source/codepage/uc866.c
* harbour/source/codepage/uc88591b.c
* harbour/source/codepage/uc8859_1.c
* harbour/source/codepage/uc8859_2.c
* harbour/source/codepage/uc8859_5.c
* harbour/source/codepage/uckoi8.c
* harbour/source/codepage/uckoi8u.c
* harbour/source/codepage/ucmaz.c
* updated unicode values for characters in rabge 1-31 to keep
DOS compatibility
* harbour/source/common/expropt1.c
* harbour/source/common/hbarch.c
* harbour/source/common/hbdate.c
* harbour/source/common/hbstr.c
* harbour/source/common/hbver.c
* keep HB_EXPORT at the beginning of function declaration
* harbour/include/hbpcode.h
* harbour/include/hbcomp.h
* harbour/source/compiler/harbour.c
* harbour/source/compiler/harbour.y
* harbour/source/compiler/hbfix.c
+ harbour/source/compiler/hbdead.c
* harbour/source/compiler/hbpcode.c
+ harbour/source/compiler/hbstripl.c
% rewritten jump optimization
! fixed some minor problems
* do not optimize jumps and local variable access by shorter
PCODE version and HB_P_NOOP when jump optimization is
disabled, this is a note I left in source code in few places:
/*
* optimizing jumps here by shorting them and setting HB_P_NOOPs
* only slow down the compilation process for three reasons:
* 1. When it's dummy jump to next instruction we need two passes
* in hb_compOptimizeJumps() to fully remove it
* 2. hb_compOptimizeJumps() also make jump shortcutting in each pass
* 3. When Jump Optimization is disabled (-kJ) then it cause slowness
* at runtime because we will have more HVM loops: first for the
* shorter jump and next for the HB_P_NOOP PCODE(s)
* [druzuz]
*/
+ added support for multi passes in jump/dead code elimination
(hb_compOptimizeJumps())
By default is set upto three passes.
Now hb_compOptimizeJumps() keeps all compiler internal data clean
on exist and can be called any times and does not change other
compiler's functions behaviors
+ added dummy jumps elimination
+ added optimization for:
IF .T.
IF .F.
WHILE .T.
WHILE .F.
etc.
* restored empty BEGIN/RECOVER sequence block elimination
if Jump Optimization is enabled then it marks the block
with HB_P_NOOPS else it cut the generated PCODE
+ added dead code eliminator (new functions hb_compCodeTraceMarkDead()/
hb_compPCodeTrace() - it works only when Jump Optimization is
not disabled)
As a result of the above we have smaller and faster PCODE.
I do not think that we will have meta code support in the reasonable
time and because I need some valid compiler data/structures like
updated table of all jumps for real C code (not PCODE in .c files)
generation then I decide to make some modifications and the above
is in practice a side effect of this work.
* harbour/source/rdd/dbcmd.c
* harbour/source/rdd/dbf1.c
* harbour/source/rdd/rddord.prg
* harbour/source/rdd/workarea.c
* harbour/source/rdd/dbfcdx/dbfcdx1.c
* harbour/source/rdd/dbffpt/dbffpt1.c
* harbour/source/rdd/dbfntx/dbfntx1.c
* harbour/source/rdd/nulsys/nulsys.c
* synced with my modifications in xHarbour
* updated for API modifications
* harbour/source/rtl/Makefile
+ added gtsys.c, gtfunc.c, hbgtcore.c
* harbour/source/rtl/accept.c
* harbour/source/rtl/alert.prg
* harbour/source/rtl/cdpapi.c
* harbour/source/rtl/console.c
* harbour/source/rtl/dates.c
* harbour/source/rtl/do.c
* harbour/source/rtl/errorapi.c
* harbour/source/rtl/errorsys.prg
* harbour/source/rtl/file.c
* harbour/source/rtl/fserror.c
* harbour/source/rtl/fstemp.c
* harbour/source/rtl/hbffind.c
* harbour/source/rtl/idle.c
* harbour/source/rtl/math.c
* harbour/source/rtl/oldclear.c
* harbour/source/rtl/strmatch.c
* harbour/source/rtl/strpeek.c
* harbour/source/rtl/valtype.c
* harbour/source/rtl/xsavescr.c
* updated for API modifications
* cleaned some compiler warnings
* harbour/source/rtl/filesys.c
+ added hb_fsGetOsHandle()
* updated for API modifications
* harbour/source/rtl/gt.c
* harbour/source/rtl/gtapi.c
* harbour/source/rtl/gtapiu.c
+ harbour/source/rtl/gtfunc.c
+ harbour/source/rtl/gtsys.c
+ harbour/source/rtl/hbgtcore.c
* harbour/source/rtl/inkey.c
* harbour/source/rtl/maxrow.c
* harbour/source/rtl/mouseapi.c
* harbour/source/rtl/setcolor.c
* harbour/source/rtl/setposbs.c
* harbour/source/rtl/shadow.c
* new GT API code
* harbour/source/rtl/saverest.c
* changed default behavior in SEVESCREEN/RESTSCREEN with parameters
out of screen range to be Clipper compatible. Added last logical
parameter to keep previous behavior for programs which begins to
use it.
* harbour/source/rtl/seconds.c
* include missing header file to fix C++ compilation
* make hb_secondsCPU global function
* harbour/source/rtl/set.c
* make HB_SET_TYPEAHEAD Clipper compatible
* harbour/source/rtl/gtcgi/Makefile
* harbour/source/rtl/gtcgi/gtcgi.c
- harbour/source/rtl/gtcgi/mousecgi.c
* rewritten for new GT API
some detail behaviors has been changed but I think the current
implementation is better for CGI programs output - please check
and fix me if necessary
* harbour/source/rtl/gtcrs/Makefile
- harbour/source/rtl/gtcrs/charmap.prg
+ harbour/source/rtl/gtcrs/chrmap.c
- harbour/source/rtl/gtcrs/debug.map
- harbour/source/rtl/gtcrs/eterm.map
* harbour/source/rtl/gtcrs/gtcrs.c
+ harbour/source/rtl/gtcrs/gtcrs.h
+ harbour/source/rtl/gtcrs/hb-charmap.def
- harbour/source/rtl/gtcrs/kbdcrs.c
- harbour/source/rtl/gtcrs/keymap.prg
- harbour/source/rtl/gtcrs/linux.map
- harbour/source/rtl/gtcrs/mousecrs.c
* new GTCRS based on my xHarbour and Flagship curses code
Please not that at runtime it looks for a file
/etc/harbour/hb-charmap.def where user can fully tune output
for his terminal. This file is included with proper path in
binaries created by make_rpm.sh and make_tgz.sh
Ryszard I've removed some of your extensions which are no longer
necessary and some other (keyboard sequence redefinition) should
be done in a little bit differ way. I would like to talk about it
when you test current code.
Added support for extended mouse keys (middle button and wheel).
* harbour/source/rtl/gtdos/Makefile
* harbour/source/rtl/gtdos/gtdos.c
- harbour/source/rtl/gtdos/mousedos.c
* rewritten for new GT API
Fixed some small problems, finished mouse code which for DJGPP
is fully Clipper compatible with real mouse SAVE/RESTORE code.
For other compilers it should be updated depending on memory
model and used DPMI driver (if any).
* harbour/source/rtl/gtos2/Makefile
* harbour/source/rtl/gtos2/gtos2.c
- harbour/source/rtl/gtos2/mouseos2.c
* rewritten for new GT API
Fixed some problems and finished the mouse code.
Please test it - I made all modifications without OS2 and
I was not able to make any test. I'm interesting in information
if it works and the speed difference - f.e. results from
tests/vidtest.prg run with previous and current version.
* harbour/source/rtl/gtpca/Makefile
* harbour/source/rtl/gtpca/gtpca.c
- harbour/source/rtl/gtpca/kbdos2.gcc
- harbour/source/rtl/gtpca/mousepca.c
* rewritten for new GT API
and finished so now it's full functional GT driver
I'm interesting in keyboard sequences used by PC-ANSI drivers
in DOS so it will be possible to implement also support for
extended keys input.
* harbour/source/rtl/gtsln/Makefile
* harbour/source/rtl/gtsln/gtsln.c
+ harbour/source/rtl/gtsln/gtsln.h
* harbour/source/rtl/gtsln/kbsln.c
* harbour/source/rtl/gtsln/keytrans.c
* harbour/source/rtl/gtsln/mousesln.c
* rewritten for new GT API basing on current xHarbour code
added support for slang 1.4x patched for UNICODE (Debian
patches used by most of current Linux distributions) and
slang 2.x - It's unicode ready, tries to detect terminal mode
(utf-8/iso) at startup and switch the internal logic to
iso/unicode mode. When compiled with slang 1.4x or 2.x
and terminal is in UTF-8 it can display all characters like
in DOS if only used font have them or good fall-back table is
loaded (f.e. the one created by QRCZAK)
Added support for extended mouse keys (middle button and wheel).
* harbour/source/rtl/gtstd/Makefile
* harbour/source/rtl/gtstd/gtstd.c
- harbour/source/rtl/gtstd/mousestd.c
* rewritten for new GT API
Now it can work as full screen GT driver redrawing the previous
screen contents from internal GT core buffers. I run with this
GT some of my programs and they work quite well ;-) of course
without colors.
* harbour/source/rtl/gtwin/Makefile
* harbour/source/rtl/gtwin/gtwin.c
- harbour/source/rtl/gtwin/mousewin.c
* updated for new GT API
+ harbour/source/rtl/gtxwc/Makefile
+ harbour/source/rtl/gtxwc/gtxwc.c
+ harbour/source/rtl/gtxwc/gtxwc.h
* new XWindow Console GT driver based on my and Giancarlo Niccolai
code form xHarbour - this GT can work in XWindow environment only
and create its own window for console output. It delays the
initialization to the moment when user try to display anything on
the screen so even without X Window system programs which uses this
GT can work as long as use only outstd/outerr output.
* harbour/source/vm/arrays.c
* updated for API modifications
+ added hb_arrayId(),
* changed hb_arrayClone() declaration to:
HB_EXPORT PHB_ITEM hb_arrayClone( PHB_ITEM pSrcArray )
* changed hb_arrayFromParams() declaration to:
PHB_ITEM hb_arrayFromParams( int iLevel )
* harbour/source/vm/arrayshb.c
* updated for API modifications
+ added new parameter iLevel to function HB_APARAMS()
* harbour/source/vm/classes.c
* harbour/source/vm/cmdarg.c
* harbour/source/vm/dynlibhb.c
* harbour/source/vm/estack.c
* harbour/source/vm/fm.c
* harbour/source/vm/garbage.c
* harbour/source/vm/maindll.c
* harbour/source/vm/maindllh.c
* harbour/source/vm/maindllp.c
* harbour/source/vm/mainstd.c
* harbour/source/vm/mainwin.c
* harbour/source/vm/memvars.c
* harbour/source/vm/pcount.c
* harbour/source/vm/proc.c
* updated for API modifications
* harbour/source/vm/codebloc.c
* updated for API modifications
+ added hb_codeblockId()
* harbour/source/vm/dynsym.c
* updated for API modifications
+ added new functions:
hb_dynsymFindSymbol(), hb_dynsymGetSymbol(),
hb_dynsymSymbol(), hb_dynsymName(),
hb_dynsymMemvarHandle(), hb_dynsymAreaHandle(), hb_dynsymSetAreaHandle()
* harbour/source/vm/eval.c
* updated for API modifications
* call hb_vmPushState()/hb_vmPopState() in hb_itemDo()/hb_itemDoC()
functions - it's necessary to make HVM reentrant safe.
* harbour/source/vm/extend.c
* updated for API modifications
+ added hb_extIsObject() similar to existing hb_extIsArray()
* harbour/source/vm/hvm.c
* updated for API modifications
+ added new functions: hb_vmPushState(), hb_vmPopState()
which save/restore HVM state (the top stack value which can be
processed and return item and maybe sth else in the future) making
HVM ready for reentrant.
* harbour/source/vm/itemapi.c
* updated for API modifications
+ added new function:
HB_EXPORT PHB_SYMB hb_itemGetSymbol( PHB_ITEM pItem );
! fixed bug in hb_itemPutNInt()
* harbour/tests/Makefile
* harbour/utils/hbdoc/Makefile
* harbour/utils/hbextern/Makefile
* harbour/utils/hbmake/Makefile
* harbour/utils/hbrun/Makefile
* harbour/utils/hbtest/Makefile
- removed badly added: dbfntx, dbfcdx, dbffpt, hbsix libraries.
what broke GNU make compilation for some compilers
This libraries should be included automatically when RDD lib
is included by *.cf files
Summary:
The whole patch (cvs diff -uN) is ~1.5MB length and I cannot describe
everything in details - sorry but it was too much modifications in
one commit so now just some of general notes.
The header files included as is does not have any information about
internal HVM structures and some functions. In practice only HB_SYMB
is public and it has to be public for .c files generated from .prg
so I force the fixed size of this structure (alignment independent)
by redefining some members to union with void * - it's a little bit
ugly trick but it effectively eliminates the problem of linking
binaries compiled with differ alignment C compiler switches.
The structures like HB_ITEM, HB_CODEBLOCK, HB_STACK, HB_DYNS are not
longer defined and pointers to the defined as void * - like in Clipper
the ITEM structure. It caused that I had to add some new functions
to make some operation still possible to implement. If I missed sth
and any of you will have a problem with your code then please inform
me about it and after a small discussion on Harbour developers list
we can decide if other functions should be added.
The internal API is still accessible. It's enough to include "hbvmopt.h"
file before other header files to enable it. Now only files in
source/vm directory include it.
The 3-rd party code which does not include hbvmopt.h (or tries to
set some internals macros) should be safe for future HVM modifications
and will work also with new binaries so 3-rd party library developers
should remember about it. If they won't then it's only their and
their clients problem not Harbour developers.
With this modifications I also create new GT model which is similar
to the one used by RDD with multi inheritance. It can be quite easy
extended to simultaneously load more then one GT subsystem (sth like
work areas in RDD) but I left it for the future when someone may
need it. hbapigt.h file now contains only information about public
functions and does not have any code which depends on current
internal implementation - it should be backword compatible as long
as somone did not try to use internal GT functions.
The internal GT system use hbgtcore.h file which should not be
included by 3-rd party code as long as someone will not make new
GT driver. The internal GT code is new so I expect that it will
be changed yet in the nearest future (I'm waiting for other developers
feedback) and in such case any 3-rd party GTs will have to be updated.
How it works:
The base GT driver (GTNUL) is fully functional GT driver which
makes all operations on memory buffer. After each screen write
Flush() method is called which check for dispcount() and if
it's 0 then call Refresh() method to update modified area by
Redraw() method. This method is dummy in GTNUL and external
output with this GT can be reached by outstd()/outerr() which
are now redirected to GT methods. A simple GT driver may overload
only Refresh() method to give full screen output.
Application can use only this GT driver and it seems to be very
good choice for GUI and background daemon/service programs.
This GT is loaded at startup then all other GTs can be loaded
later and inherit from the previously loaded GT drivers.
The new GT driver can overload as much method as wants/needs.
Now all GT operations are implemented as GT method so GT driver
can easy change their default behavior, f.e. it may fully overload
color parsing methods and use differ or extended to Clipper color
definitions.
I rewrote all existing GTs to work with new GT model.
OS2 users - please test GTOS2 which I was not able to test and
see the note in Redraw() method. If possible please make some
speed tests.
In fact now there is much more internal operations then it was
before but because they are done on memory only then current
code is much faster in this GT drivers which so far makes all
operations on real video area. I made some tests with GTNUL
and tests/vidtest.prg and the total overhead is minimal. Now
dipbegin()/dispend() in practice does not cost anything so it
gives additional speed improvement in application which extensively
use it.
More then one GT driver can be linked with final binaries and
chose on application startup by //GT<NAME> switch and/or environment
variable HB_GT=<name>
In the RTL is new GT function GTSYS() which works in similar way
to RDDSYS() in RDD subsystem and for linking default GT driver
for given platform. When RTL is compiled the default GT driver
is set to HB_GT_DEFAULT envvar and if not exist to HB_GT_LIB
envvar and if it also does not exist to hard coded platfom GTs
(see source/rtl/gtsys.c and source/rtl/Makefile for rules)
Adding to source code:
ANNOUNCE GTSYS
disable linking the default GT driver and:
REQUEST HB_GT_<name>
for linking given (<name>) GT driver, f.e.: REQUEST HB_GT_WIN
If you are working in SH environment (Linux and other *nixes users,
DJGPP bash, MinGW shell then it's possible to use -gt<name> switch
in hblnk / hbmk scripts to force linking GT drivers (it could be
repeated with different <name>) and the first one becomes the default
one. F.e.:
xhbmk -m -n -w -es2 -gtcrs -gtsln -gtstd -gtpca vidtest.prg
Usually the GT driver are loaded at HVM startup but it's possible
to load it later. I created new GT driver CTW which gives full
CT3 like Window system. The CT3 extended driver change the behavior
of some function in Clipper extended driver, f.e WRITECON() or
SETPOS() with parameters out of screen range. So I implemented it
CTW as RT GTs which is loaded when some of CTWIN function is used
(f.e. WOPEN()/WBOARD()) and inherits from any existing GT driver.
This is full CT3 WIN implementation with all detail behaviors I
found (with some CT3 bug fixes). It does not have any CT3 limitations
and can be used for any virtual screen/window size though I hardcoded
CT3 limitation for backword compatibility. If somone will want to
remove it then it will be enough to delete few lines from ctwin.c
file. I'm not CTWIN Clipper user so maybe I missed some side effects
in this driver and was not able to well test it so if you will find
any incompatibilities then please inform me.
THe default GT buffer uses 32bit character cell internally but
in savescreen/restscreen it uses VGA compatible two bytes character
cell. Some GT drivers may want to use differ character cell.
Now GTCRS and GTSLN use 32bit character cell by default. They
need additional information about character set (box/normal) to
properly display box characters. It is possible to force in this
GT drivers using Clipper compatible character cell by calling:
hb_gtInfo( GTI_COMPATBUFFER, <lCompat> ) -> <lPreviousSeting>
but in may cause that box drawing characters will be lost in
some countries after RESTSCREEN(). It will depend on used code
page.
HB_GTINFO() is new function which works in similar way to DBINFO()
in RDD. It allows to retrieve/change some of GT driver settings.
GTI_* actions are defined in hbgtinfo.ch - it has all GTI_*
definitions used in xHarbour. Now in Harbour only few of them
are implemented.
The new three .prg functions:
HB_SETKEYCP( <cTermCP> [,<cHostCP>] )
HB_SETDISPCP( <cTermCP> [,<cHostCP>] [,<lBoxChar>] )
HB_SETTERMCP( <cTermCP> [,<cHostCP>] [,<lBoxChar>] )
have been added. They set automatic input (HB_SETKEYCP)
and output (HB_SETDISPCP) (or both: HB_SETTERMCP) character
translation. They are also important for some GTs which
informing them about used internal code page for unicode
translation (GTXWC, GTSLN) and/or chosing proper character
set (standard/alternate) for letters and other (f.e. box
drawing characters) (GTCRS, GTSLN),
<cTermCP> is encoding used on external (terminal) side
<cHostCP> is encoding used internally, if not given then
current code page set HB_SETCODEPAGE() is used.
some of GTs which uses unicode output may
ignore <cTermCP>
<lBoxChar> is optional parameter which interacts with dispbox()
output disabling switching to alternate character
set in some GTs. It effectively causes that if internal
(host) code page contains some letters on the box char
positions then they will be shown also by box drawing
functions like dispbox() instead of CP437 characters.
In some cases it could be useful. By default lBoxChar
is not set and GTs which can switch between standard
and alternate character set (GTCRS, GTSLN) will try to
use alternate character set for box drawing functions.
Victor: I removed some of your functions. They can be very easy
implemented with hb_gt_GetChar()/hb_gt_PutChar() but I do not want to
make them part of documented external API because some GT drivers may
want to use absolutely differ color definitions and they will stop to
work so I do not want to make this functions documented external API.
Ryszard: Setting alternative debug keys does not longer work.
I like such possibilities but it should be implemented in differ
way to f.e. using HB_GTINFO interface to allow low level GT driver
extensions, f.e. in *nixes using CTRL+[A-Z] and SIGINT, SIGQUIT,
SIGTSTP signals for real asynchronous setting of debug/cancel flag
without keyboard polling from main HVM loop. I would like to discus
about such more general solution.
*** Please updated non GNU make files ***
1676 lines
48 KiB
C
1676 lines
48 KiB
C
/*
|
|
* $Id$
|
|
*/
|
|
|
|
/*
|
|
* Harbour Project source code:
|
|
* Memvar (PRIVATE/PUBLIC) runtime support
|
|
*
|
|
* Copyright 1999 Ryszard Glab <rglab@imid.med.pl>
|
|
* www - http://www.harbour-project.org
|
|
*
|
|
* This program is free software; you can redistribute it and/or modify
|
|
* it under the terms of the GNU General Public License as published by
|
|
* the Free Software Foundation; either version 2, or (at your option)
|
|
* any later version.
|
|
*
|
|
* This program is distributed in the hope that it will be useful,
|
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
* GNU General Public License for more details.
|
|
*
|
|
* You should have received a copy of the GNU General Public License
|
|
* along with this software; see the file COPYING. If not, write to
|
|
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
|
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
|
|
*
|
|
* As a special exception, the Harbour Project gives permission for
|
|
* additional uses of the text contained in its release of Harbour.
|
|
*
|
|
* The exception is that, if you link the Harbour libraries with other
|
|
* files to produce an executable, this does not by itself cause the
|
|
* resulting executable to be covered by the GNU General Public License.
|
|
* Your use of that executable is in no way restricted on account of
|
|
* linking the Harbour library code into it.
|
|
*
|
|
* This exception does not however invalidate any other reasons why
|
|
* the executable file might be covered by the GNU General Public License.
|
|
*
|
|
* This exception applies only to the code released by the Harbour
|
|
* Project under the name Harbour. If you copy code from other
|
|
* Harbour Project or Free Software Foundation releases into a copy of
|
|
* Harbour, as the General Public License permits, the exception does
|
|
* not apply to the code that you add in this way. To avoid misleading
|
|
* anyone as to the status of such modified files, you must delete
|
|
* this exception notice from them.
|
|
*
|
|
* If you write modifications of your own for Harbour, it is your choice
|
|
* whether to permit this exception to apply to your modifications.
|
|
* If you do not wish that, delete this exception notice.
|
|
*
|
|
*/
|
|
|
|
/*
|
|
* The following parts are Copyright of the individual authors.
|
|
* www - http://www.harbour-project.org
|
|
*
|
|
* Copyright 1999-2001 Viktor Szakats <viktor.szakats@syenar.hu>
|
|
* __MVSAVE()
|
|
* __MVRESTORE() (Thanks to Dave Pearson and Jo French for the original
|
|
* Clipper function (FReadMem()) to read .mem files)
|
|
*
|
|
* See doc/license.txt for licensing terms.
|
|
*
|
|
*/
|
|
|
|
#include <ctype.h> /* for toupper() function */
|
|
|
|
#include "hbvmopt.h"
|
|
#include "hbapi.h"
|
|
#include "hbapiitm.h"
|
|
#include "hbapierr.h"
|
|
#include "hbapifs.h" /* for __MVSAVE()/__MVRESTORE() */
|
|
#include "hbdate.h" /* for __MVSAVE()/__MVRESTORE() */
|
|
#include "hbcomp.h" /* for VS_* macros */
|
|
#include "error.ch"
|
|
#include "hbmemvar.ch"
|
|
#include "hbset.h"
|
|
#include "hbstack.h"
|
|
|
|
static PHB_DYNS * s_privateStack = NULL;
|
|
static ULONG s_privateStackSize = 0;
|
|
static ULONG s_privateStackCnt = 0;
|
|
static ULONG s_privateStackBase = 0;
|
|
|
|
static ULONG s_globalTableSize = 0;
|
|
static ULONG s_globalFirstFree = 0;
|
|
static ULONG s_globalLastFree = 0;
|
|
static HB_VALUE_PTR s_globalTable = NULL;
|
|
|
|
#define TABLE_INITHB_VALUE 100
|
|
#define TABLE_EXPANDHB_VALUE 50
|
|
|
|
struct mv_PUBLIC_var_info
|
|
{
|
|
int iPos;
|
|
BOOL bFound;
|
|
HB_DYNS_PTR pDynSym;
|
|
};
|
|
|
|
static void hb_memvarCreateFromDynSymbol( PHB_DYNS, BYTE, PHB_ITEM );
|
|
static void hb_memvarAddPrivate( PHB_DYNS );
|
|
static void hb_memvarReleasePublic( PHB_ITEM pMemVar );
|
|
static HB_DYNS_PTR hb_memvarFindSymbol( HB_ITEM_PTR );
|
|
|
|
void hb_memvarsInit( void )
|
|
{
|
|
HB_TRACE(HB_TR_DEBUG, ("hb_memvarsInit()"));
|
|
|
|
s_globalTable = ( HB_VALUE_PTR ) hb_xgrab( sizeof( HB_VALUE ) * TABLE_INITHB_VALUE );
|
|
s_globalTableSize = TABLE_INITHB_VALUE;
|
|
s_globalFirstFree = 0;
|
|
s_globalLastFree = 1;
|
|
|
|
s_privateStack = ( PHB_DYNS * ) hb_xgrab( sizeof( PHB_DYNS ) * TABLE_INITHB_VALUE );
|
|
s_privateStackSize = TABLE_INITHB_VALUE;
|
|
s_privateStackCnt = s_privateStackBase = 0;
|
|
}
|
|
|
|
/* clear all variables except the detached ones
|
|
* Should be called at application exit only
|
|
*/
|
|
void hb_memvarsRelease( void )
|
|
{
|
|
ULONG ulCnt = s_globalLastFree;
|
|
|
|
HB_TRACE(HB_TR_DEBUG, ("hb_memvarsClear()"));
|
|
|
|
if( s_globalTable )
|
|
{
|
|
while( --ulCnt )
|
|
{
|
|
if( s_globalTable[ ulCnt ].counter && s_globalTable[ ulCnt ].hPrevMemvar != ( HB_HANDLE )-1 )
|
|
{
|
|
hb_itemClear( s_globalTable[ ulCnt ].pVarItem );
|
|
hb_xfree( s_globalTable[ ulCnt ].pVarItem );
|
|
s_globalTable[ ulCnt ].counter = 0;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
void hb_memvarsFree( void )
|
|
{
|
|
if( s_globalTable )
|
|
hb_xfree( s_globalTable );
|
|
|
|
if( s_privateStack )
|
|
hb_xfree( s_privateStack );
|
|
}
|
|
|
|
/*
|
|
* This function base address of values table
|
|
*/
|
|
HB_VALUE_PTR *hb_memvarValueBaseAddress( void )
|
|
{
|
|
return &s_globalTable;
|
|
}
|
|
|
|
/*
|
|
* This function creates new global value.
|
|
*
|
|
* pSource = item value that have to be stored or NULL
|
|
* bTrueMemvar = TRUE | FALSE
|
|
* FALSE if function is called to create memvar variable for a codeblock
|
|
* (to store detached local variable) - in this case we have to do
|
|
* exact copy of passed item (without duplicating its value and
|
|
* without reference decrementing)
|
|
* TRUE if we are creating regular memvar variable (PUBLI or PRIVATE)
|
|
* In this case we have to do normal item coping.
|
|
*
|
|
* Returns:
|
|
* handle to variable memory or fails
|
|
*
|
|
*/
|
|
HB_HANDLE hb_memvarValueNew( HB_ITEM_PTR pSource, BOOL bTrueMemvar )
|
|
{
|
|
HB_VALUE_PTR pValue;
|
|
HB_HANDLE hValue; /* handle 0 is reserved */
|
|
/* = 1 removed, since it's initialized in all branches. Caused a warning with Borland C++ */
|
|
|
|
HB_TRACE(HB_TR_DEBUG, ("hb_memvarValueNew(%p, %d)", pSource, (int) bTrueMemvar));
|
|
|
|
if( s_globalFirstFree )
|
|
{
|
|
/* There are holes in the table - get a first available one
|
|
*/
|
|
hValue = s_globalFirstFree;
|
|
s_globalFirstFree = s_globalTable[ hValue ].hPrevMemvar;
|
|
}
|
|
else
|
|
{
|
|
/* Allocate the value from the end of table
|
|
*/
|
|
if( s_globalLastFree < s_globalTableSize )
|
|
{
|
|
hValue = s_globalLastFree++;
|
|
}
|
|
else
|
|
{
|
|
/* No more free values in the table - expand the table
|
|
*/
|
|
hValue = s_globalTableSize;
|
|
s_globalLastFree = s_globalTableSize + 1;
|
|
s_globalTableSize += TABLE_EXPANDHB_VALUE;
|
|
s_globalTable = ( HB_VALUE_PTR ) hb_xrealloc( s_globalTable, sizeof( HB_VALUE ) * s_globalTableSize );
|
|
}
|
|
}
|
|
|
|
pValue = s_globalTable + hValue;
|
|
pValue->pVarItem = ( HB_ITEM_PTR ) hb_xgrab( sizeof( HB_ITEM ) );
|
|
pValue->counter = 1;
|
|
pValue->pVarItem->type = HB_IT_NIL;
|
|
if( pSource )
|
|
{
|
|
if( bTrueMemvar )
|
|
hb_itemCopy( pValue->pVarItem, pSource );
|
|
else
|
|
memcpy( pValue->pVarItem, pSource, sizeof(HB_ITEM) );
|
|
}
|
|
|
|
if( bTrueMemvar )
|
|
pValue->hPrevMemvar = 0;
|
|
else
|
|
pValue->hPrevMemvar = ( HB_HANDLE )-1; /* detached variable */
|
|
|
|
HB_TRACE(HB_TR_INFO, ("hb_memvarValueNew: memvar item created with handle %i", hValue));
|
|
|
|
return hValue;
|
|
}
|
|
|
|
/* Detach local variable (swap current value with a memvar handle)
|
|
*/
|
|
HB_ITEM_PTR hb_memvarDetachLocal( HB_ITEM_PTR pLocal )
|
|
{
|
|
HB_TRACE(HB_TR_DEBUG, ("hb_memvarDetachLocal(%p, %d)", pLocal, pLocal->type ));
|
|
|
|
if( HB_IS_BYREF( pLocal ) && ! HB_IS_MEMVAR( pLocal ) )
|
|
{
|
|
HB_ITEM_PTR pItem = pLocal;
|
|
|
|
do
|
|
{
|
|
pLocal = hb_itemUnRefOnce( pLocal );
|
|
}
|
|
while( HB_IS_BYREF( pLocal ) && ! HB_IS_MEMVAR( pLocal ) && ( pLocal != pItem ) );
|
|
}
|
|
|
|
/* 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
|
|
*/
|
|
if ( ! HB_IS_MEMVAR( pLocal ) )
|
|
{
|
|
HB_HANDLE hMemvar = hb_memvarValueNew( pLocal, FALSE );
|
|
|
|
pLocal->type = HB_IT_BYREF | HB_IT_MEMVAR;
|
|
pLocal->item.asMemvar.itemsbase = &s_globalTable;
|
|
pLocal->item.asMemvar.value = hMemvar;
|
|
}
|
|
return pLocal;
|
|
}
|
|
|
|
|
|
/*
|
|
* This function pushes passed dynamic symbol that belongs to PRIVATE variable
|
|
* into the stack. The value will be popped from it if the variable falls
|
|
* outside the scope (either by using RELEASE, CLEAR ALL, CLEAR MEMORY or by
|
|
* an exit from the function/procedure)
|
|
*
|
|
*/
|
|
static void hb_memvarAddPrivate( PHB_DYNS pDynSym )
|
|
{
|
|
HB_TRACE(HB_TR_DEBUG, ("hb_memvarAddPrivate(%p)", pDynSym));
|
|
|
|
/* Allocate the value from the end of table
|
|
*/
|
|
if( s_privateStackCnt == s_privateStackSize )
|
|
{
|
|
/* No more free values in the table - expand the table
|
|
*/
|
|
s_privateStackSize += TABLE_EXPANDHB_VALUE;
|
|
s_privateStack = ( PHB_DYNS * ) hb_xrealloc( s_privateStack, sizeof( PHB_DYNS ) * s_privateStackSize );
|
|
}
|
|
|
|
s_privateStack[ s_privateStackCnt++ ] = pDynSym;
|
|
}
|
|
|
|
/*
|
|
* This function returns current PRIVATE variables stack base
|
|
*/
|
|
ULONG hb_memvarGetPrivatesBase( void )
|
|
{
|
|
ULONG ulBase = s_privateStackBase;
|
|
|
|
HB_TRACE(HB_TR_DEBUG, ("hb_memvarGetPrivatesBase()"));
|
|
|
|
s_privateStackBase = s_privateStackCnt;
|
|
return ulBase;
|
|
}
|
|
|
|
/*
|
|
* This function releases PRIVATE variables created after passed base
|
|
*
|
|
*/
|
|
void hb_memvarSetPrivatesBase( ULONG ulBase )
|
|
{
|
|
HB_HANDLE hVar, hOldValue;
|
|
|
|
HB_TRACE(HB_TR_DEBUG, ("hb_memvarSetPrivatesBase(%lu)", ulBase));
|
|
|
|
while( s_privateStackCnt > s_privateStackBase )
|
|
{
|
|
--s_privateStackCnt;
|
|
hVar = s_privateStack[ s_privateStackCnt ]->hMemvar;
|
|
if( hVar )
|
|
{
|
|
hOldValue = s_globalTable[ hVar ].hPrevMemvar;
|
|
hb_memvarValueDecRef( hVar );
|
|
/*
|
|
* Restore previous value for variables that were overridden
|
|
*/
|
|
s_privateStack[ s_privateStackCnt ]->hMemvar = hOldValue;
|
|
}
|
|
}
|
|
s_privateStackBase = ulBase;
|
|
}
|
|
|
|
/*
|
|
* This function increases the number of references to passed global value
|
|
*
|
|
*/
|
|
void hb_memvarValueIncRef( HB_HANDLE hValue )
|
|
{
|
|
HB_TRACE(HB_TR_DEBUG, ("hb_memvarValueIncRef(%lu)", hValue));
|
|
|
|
s_globalTable[ hValue ].counter++;
|
|
|
|
HB_TRACE(HB_TR_INFO, ("Memvar item (%i) increment refCounter=%li", hValue, s_globalTable[ hValue ].counter));
|
|
}
|
|
|
|
static void hb_memvarRecycle( HB_HANDLE hValue )
|
|
{
|
|
HB_TRACE(HB_TR_DEBUG, ("hb_memvarRecycle(%lu)", hValue));
|
|
|
|
if( s_globalFirstFree )
|
|
{
|
|
s_globalTable[ hValue ].hPrevMemvar = s_globalFirstFree;
|
|
s_globalFirstFree = hValue;
|
|
}
|
|
else
|
|
{
|
|
/* first free value in the list */
|
|
s_globalFirstFree = hValue;
|
|
s_globalTable[ hValue ].hPrevMemvar = 0;
|
|
}
|
|
}
|
|
|
|
/*
|
|
* This function decreases the number of references to passed global value.
|
|
* If it is the last reference then this value is deleted.
|
|
*
|
|
*/
|
|
void hb_memvarValueDecRef( HB_HANDLE hValue )
|
|
{
|
|
HB_VALUE_PTR pValue;
|
|
|
|
HB_TRACE(HB_TR_DEBUG, ("hb_memvarValueDecRef(%lu)", hValue));
|
|
|
|
pValue = s_globalTable + hValue;
|
|
|
|
HB_TRACE(HB_TR_INFO, ("Memvar item (%i) decrement refCounter=%li", hValue, pValue->counter-1));
|
|
|
|
if( pValue->counter > 0 )
|
|
{
|
|
/* Notice that Counter can be equal to 0.
|
|
* This can happen if for example PUBLIC variable holds a codeblock
|
|
* with detached variable. When hb_memvarsRelease() is called then
|
|
* detached variable can be released before the codeblock. So if
|
|
* the codeblock will be released later then it will try to release
|
|
* again this detached variable.
|
|
*/
|
|
if( --pValue->counter == 0 )
|
|
{
|
|
hb_itemClear( pValue->pVarItem );
|
|
hb_xfree( pValue->pVarItem );
|
|
hb_memvarRecycle( hValue );
|
|
|
|
HB_TRACE(HB_TR_INFO, ("Memvar item (%i) deleted", hValue));
|
|
}
|
|
}
|
|
}
|
|
|
|
/* This function is called from releasing of detached local variables
|
|
* referenced in a codeblock that is wiped out by the Garbage Collector.
|
|
* Decrement the reference counter and clear a value stored in the memvar.
|
|
* Don't clear arrays or codeblocks to avoid loops - these values will be
|
|
* released by the garbage collector.
|
|
*/
|
|
void hb_memvarValueDecGarbageRef( HB_HANDLE hValue )
|
|
{
|
|
HB_VALUE_PTR pValue;
|
|
|
|
HB_TRACE(HB_TR_DEBUG, ("hb_memvarValueDecRef(%lu)", hValue));
|
|
|
|
pValue = s_globalTable + hValue;
|
|
|
|
HB_TRACE(HB_TR_INFO, ("Memvar item (%i) decrement refCounter=%li", hValue, pValue->counter-1));
|
|
|
|
if( pValue->counter > 0 )
|
|
{
|
|
/* Notice that Counter can be equal to 0.
|
|
* This can happen if for example PUBLIC variable holds a codeblock
|
|
* with detached variable. When hb_memvarsRelease() is called then
|
|
* detached variable can be released before the codeblock. So if
|
|
* the codeblock will be released later then it will try to release
|
|
* again this detached variable.
|
|
*/
|
|
if( --pValue->counter == 0 )
|
|
{
|
|
if( HB_IS_STRING( pValue->pVarItem ) )
|
|
hb_itemClear( pValue->pVarItem );
|
|
hb_xfree( pValue->pVarItem );
|
|
hb_memvarRecycle( hValue );
|
|
|
|
HB_TRACE(HB_TR_INFO, ("Memvar item (%i) deleted", hValue));
|
|
}
|
|
}
|
|
}
|
|
|
|
/*
|
|
* This functions copies passed item value into the memvar pointed
|
|
* by symbol
|
|
*
|
|
* pMemvar - symbol associated with a variable
|
|
* pItem - value to store in memvar
|
|
*
|
|
*/
|
|
void hb_memvarSetValue( PHB_SYMB pMemvarSymb, HB_ITEM_PTR pItem )
|
|
{
|
|
PHB_DYNS pDyn;
|
|
|
|
HB_TRACE(HB_TR_DEBUG, ("hb_memvarSetValue(%p, %p)", pMemvarSymb, pItem));
|
|
|
|
pDyn = ( PHB_DYNS ) pMemvarSymb->pDynSym;
|
|
if( pDyn )
|
|
{
|
|
HB_TRACE(HB_TR_INFO, ("Memvar item (%i)(%s) assigned", pDyn->hMemvar, pMemvarSymb->szName));
|
|
|
|
if( pDyn->hMemvar )
|
|
{
|
|
/* value is already created */
|
|
HB_ITEM_PTR pSetItem = s_globalTable[ pDyn->hMemvar ].pVarItem;
|
|
if( HB_IS_BYREF( pSetItem ) )
|
|
hb_itemCopy( hb_itemUnRef( pSetItem ), pItem );
|
|
else
|
|
hb_itemCopy( pSetItem, pItem );
|
|
}
|
|
else
|
|
{
|
|
/* assignment to undeclared memvar - PRIVATE is assumed
|
|
*/
|
|
hb_memvarCreateFromDynSymbol( pDyn, VS_PRIVATE, pItem );
|
|
}
|
|
|
|
/* Remove MEMOFLAG if exists (assignment from field). */
|
|
s_globalTable[ pDyn->hMemvar ].pVarItem->type &= ~HB_IT_MEMOFLAG;
|
|
}
|
|
else
|
|
hb_errInternal( HB_EI_MVBADSYMBOL, NULL, pMemvarSymb->szName, NULL );
|
|
}
|
|
|
|
ERRCODE hb_memvarGet( HB_ITEM_PTR pItem, PHB_SYMB pMemvarSymb )
|
|
{
|
|
PHB_DYNS pDyn;
|
|
ERRCODE bSuccess = FAILURE;
|
|
|
|
HB_TRACE(HB_TR_DEBUG, ("hb_memvarGet(%p, %p)", pItem, pMemvarSymb));
|
|
|
|
pDyn = ( PHB_DYNS ) pMemvarSymb->pDynSym;
|
|
if( pDyn )
|
|
{
|
|
HB_TRACE(HB_TR_INFO, ("Memvar item (%i)(%s) queried", pDyn->hMemvar, pMemvarSymb->szName));
|
|
|
|
if( pDyn->hMemvar )
|
|
{
|
|
/* value is already created
|
|
*/
|
|
HB_ITEM_PTR pGetItem = s_globalTable[ pDyn->hMemvar ].pVarItem;
|
|
if( HB_IS_BYREF( pGetItem ) )
|
|
hb_itemCopy( pItem, hb_itemUnRef( pGetItem ) );
|
|
else
|
|
hb_itemCopy( pItem, pGetItem );
|
|
bSuccess = SUCCESS;
|
|
}
|
|
}
|
|
else
|
|
hb_errInternal( HB_EI_MVBADSYMBOL, NULL, pMemvarSymb->szName, NULL );
|
|
|
|
return bSuccess;
|
|
}
|
|
|
|
void hb_memvarGetValue( HB_ITEM_PTR pItem, PHB_SYMB pMemvarSymb )
|
|
{
|
|
HB_TRACE(HB_TR_DEBUG, ("hb_memvarGetValue(%p, %p)", pItem, pMemvarSymb));
|
|
|
|
if( hb_memvarGet( pItem, pMemvarSymb ) == FAILURE )
|
|
{
|
|
/* Generate an error with retry possibility
|
|
* (user created error handler can create this variable)
|
|
*/
|
|
USHORT uiAction = E_RETRY;
|
|
HB_ITEM_PTR pError;
|
|
|
|
pError = hb_errRT_New( ES_ERROR, NULL, EG_NOVAR, 1003,
|
|
NULL, pMemvarSymb->szName, 0, EF_CANRETRY );
|
|
|
|
while( uiAction == E_RETRY )
|
|
{
|
|
uiAction = hb_errLaunch( pError );
|
|
if( uiAction == E_RETRY )
|
|
{
|
|
if( hb_memvarGet( pItem, pMemvarSymb ) == SUCCESS )
|
|
uiAction = E_DEFAULT;
|
|
}
|
|
}
|
|
hb_errRelease( pError );
|
|
}
|
|
}
|
|
|
|
void hb_memvarGetRefer( HB_ITEM_PTR pItem, PHB_SYMB pMemvarSymb )
|
|
{
|
|
PHB_DYNS pDyn;
|
|
|
|
HB_TRACE(HB_TR_DEBUG, ("hb_memvarGetRefer(%p, %p)", pItem, pMemvarSymb));
|
|
|
|
pDyn = ( PHB_DYNS ) pMemvarSymb->pDynSym;
|
|
if( pDyn )
|
|
{
|
|
HB_TRACE(HB_TR_INFO, ("Memvar item (%i)(%s) referenced", pDyn->hMemvar, pMemvarSymb->szName));
|
|
|
|
if( pDyn->hMemvar )
|
|
{
|
|
/* value is already created */
|
|
pItem->type = HB_IT_BYREF | HB_IT_MEMVAR;
|
|
pItem->item.asMemvar.value = pDyn->hMemvar;
|
|
pItem->item.asMemvar.itemsbase = &s_globalTable;
|
|
++s_globalTable[ pDyn->hMemvar ].counter;
|
|
}
|
|
else
|
|
{
|
|
/* Generate an error with retry possibility
|
|
* (user created error handler can make this variable accessible)
|
|
*/
|
|
USHORT uiAction = E_RETRY;
|
|
HB_ITEM_PTR pError;
|
|
|
|
pError = hb_errRT_New( ES_ERROR, NULL, EG_NOVAR, 1003,
|
|
NULL, pMemvarSymb->szName, 0, EF_CANRETRY );
|
|
|
|
while( uiAction == E_RETRY )
|
|
{
|
|
uiAction = hb_errLaunch( pError );
|
|
if( uiAction == E_RETRY )
|
|
{
|
|
if( pDyn->hMemvar )
|
|
{
|
|
/* value is already created */
|
|
pItem->type = HB_IT_BYREF | HB_IT_MEMVAR;
|
|
pItem->item.asMemvar.value = pDyn->hMemvar;
|
|
pItem->item.asMemvar.itemsbase = &s_globalTable;
|
|
++s_globalTable[ pDyn->hMemvar ].counter;
|
|
uiAction = E_DEFAULT;
|
|
}
|
|
}
|
|
}
|
|
hb_errRelease( pError );
|
|
}
|
|
}
|
|
else
|
|
hb_errInternal( HB_EI_MVBADSYMBOL, NULL, pMemvarSymb->szName, NULL );
|
|
}
|
|
|
|
/*
|
|
*/
|
|
void hb_memvarNewParameter( PHB_SYMB pSymbol, PHB_ITEM pValue )
|
|
{
|
|
HB_TRACE(HB_TR_DEBUG, ("hb_memvarNewParameter(%p, %p)", pSymbol, pValue));
|
|
|
|
hb_memvarCreateFromDynSymbol( pSymbol->pDynSym, HB_MV_PRIVATE, pValue );
|
|
}
|
|
|
|
char * hb_memvarGetStrValuePtr( char * szVarName, ULONG *pulLen )
|
|
{
|
|
HB_ITEM itName;
|
|
HB_DYNS_PTR pDynVar;
|
|
char * szValue = NULL;
|
|
|
|
HB_TRACE(HB_TR_DEBUG, ("hb_memvarGetStrValuePtr(%s, %li)", szVarName, pulLen));
|
|
|
|
itName.type = HB_IT_STRING;
|
|
itName.item.asString.value = szVarName;
|
|
itName.item.asString.length = *pulLen;
|
|
pDynVar = hb_memvarFindSymbol( &itName );
|
|
|
|
if( pDynVar )
|
|
{
|
|
/* there is dynamic symbol with the requested name - check if it is
|
|
* a memvar variable
|
|
*/
|
|
if( pDynVar->hMemvar )
|
|
{
|
|
/* variable contains some data
|
|
*/
|
|
HB_ITEM_PTR pItem = s_globalTable[ pDynVar->hMemvar ].pVarItem;
|
|
if( HB_IS_BYREF( pItem ) )
|
|
pItem = hb_itemUnRef( pItem ); /* it is a PARAMETER variable */
|
|
if( HB_IS_STRING( pItem ) )
|
|
{
|
|
szValue = pItem->item.asString.value;
|
|
*pulLen = pItem->item.asString.length;
|
|
}
|
|
}
|
|
}
|
|
|
|
return szValue;
|
|
}
|
|
|
|
/*
|
|
* This function creates a value for memvar variable
|
|
*
|
|
* pMemvar - an item that stores the name of variable - it can be either
|
|
* the HB_IT_SYMBOL (if created by PUBLIC statement) or HB_IT_STRING
|
|
* (if created by direct call to __PUBLIC function)
|
|
* bScope - the scope of created variable - if a variable with the same name
|
|
* exists already then it's value is hidden by new variable with
|
|
* passed scope
|
|
* pValue - optional item used to initialize the value of created variable
|
|
* or NULL
|
|
*
|
|
*/
|
|
void hb_memvarCreateFromItem( PHB_ITEM pMemvar, BYTE bScope, PHB_ITEM pValue )
|
|
{
|
|
PHB_DYNS pDynVar = NULL;
|
|
|
|
HB_TRACE(HB_TR_DEBUG, ("hb_memvarCreateFromItem(%p, %d, %p)", pMemvar, bScope, pValue));
|
|
|
|
/* find dynamic symbol or creeate one */
|
|
if( HB_IS_SYMBOL( pMemvar ) )
|
|
pDynVar = hb_dynsymGet( pMemvar->item.asSymbol.value->szName );
|
|
else if( HB_IS_STRING( pMemvar ) )
|
|
pDynVar = hb_dynsymGet( pMemvar->item.asString.value );
|
|
else
|
|
hb_errRT_BASE( EG_ARG, 3008, NULL, "&", 2, hb_paramError( 1 ), hb_paramError( 2 ) );
|
|
|
|
if( pDynVar )
|
|
hb_memvarCreateFromDynSymbol( pDynVar, bScope, pValue );
|
|
}
|
|
|
|
static void hb_memvarCreateFromDynSymbol( PHB_DYNS pDynVar, BYTE bScope, PHB_ITEM pValue )
|
|
{
|
|
HB_TRACE(HB_TR_DEBUG, ("hb_memvarCreateFromDynSymbol(%p, %d, %p)", pDynVar, bScope, pValue));
|
|
|
|
if( bScope & VS_PUBLIC )
|
|
{
|
|
/* If the variable with the same name exists already
|
|
* then the current value have to be unchanged
|
|
*/
|
|
if( ! pDynVar->hMemvar )
|
|
{
|
|
pDynVar->hMemvar = hb_memvarValueNew( pValue, TRUE );
|
|
if( !pValue )
|
|
{
|
|
/* new PUBLIC variable - initialize it to .F.
|
|
*/
|
|
|
|
s_globalTable[ pDynVar->hMemvar ].pVarItem->type = HB_IT_LOGICAL;
|
|
|
|
/* NOTE: PUBLIC variables named CLIPPER and HARBOUR are initialized */
|
|
/* to .T., this is normal Clipper behaviour. [vszakats] */
|
|
|
|
if( strcmp( pDynVar->pSymbol->szName, "HARBOUR" ) == 0 ||
|
|
strcmp( pDynVar->pSymbol->szName, "CLIPPER" ) == 0 )
|
|
s_globalTable[ pDynVar->hMemvar ].pVarItem->item.asLogical.value = TRUE;
|
|
else
|
|
s_globalTable[ pDynVar->hMemvar ].pVarItem->item.asLogical.value = FALSE;
|
|
}
|
|
}
|
|
}
|
|
else
|
|
{
|
|
/* We need to store the handle to the value of variable that is
|
|
* visible at this moment so later we can restore this value when
|
|
* the new variable will be released
|
|
*/
|
|
HB_HANDLE hCurrentValue = pDynVar->hMemvar;
|
|
|
|
pDynVar->hMemvar = hb_memvarValueNew( pValue, TRUE );
|
|
s_globalTable[ pDynVar->hMemvar ].hPrevMemvar = hCurrentValue;
|
|
|
|
/* Add this variable to the PRIVATE variables stack
|
|
*/
|
|
hb_memvarAddPrivate( pDynVar );
|
|
}
|
|
}
|
|
|
|
/* This function releases all memory occupied by a memvar variable
|
|
* It also restores the value that was hidden if there is another
|
|
* PRIVATE variable with the same name.
|
|
*/
|
|
static void hb_memvarRelease( HB_ITEM_PTR pMemvar )
|
|
{
|
|
HB_TRACE(HB_TR_DEBUG, ("hb_memvarRelease(%p)", pMemvar));
|
|
|
|
if( HB_IS_STRING( pMemvar ) )
|
|
{
|
|
ULONG ulBase = s_privateStackCnt;
|
|
PHB_DYNS pDynVar;
|
|
|
|
/* Find the variable with a requested name that is currently visible
|
|
* Start from the top of the stack.
|
|
*/
|
|
while( ulBase > 0 )
|
|
{
|
|
pDynVar = s_privateStack[ --ulBase ];
|
|
|
|
/* reset current value to NIL - the overriden variables will be
|
|
* visible after exit from current procedure
|
|
*/
|
|
if( pDynVar->hMemvar )
|
|
{
|
|
if( hb_stricmp( pDynVar->pSymbol->szName, pMemvar->item.asString.value ) == 0 )
|
|
{
|
|
hb_itemClear( s_globalTable[ pDynVar->hMemvar ].pVarItem );
|
|
return;
|
|
}
|
|
}
|
|
}
|
|
/* No match found for PRIVATEs - try PUBLICs.
|
|
*/
|
|
hb_memvarReleasePublic( pMemvar );
|
|
}
|
|
else
|
|
hb_errRT_BASE( EG_ARG, 3008, NULL, "RELEASE", 1, hb_paramError( 1 ) );
|
|
}
|
|
|
|
|
|
/* This function releases all memory occupied by a memvar variable and
|
|
* assigns NIL value - it releases variables created in current
|
|
* procedure only.
|
|
* The scope of released variables are specified using passed name's mask
|
|
*/
|
|
static void hb_memvarReleaseWithMask( char *szMask, BOOL bInclude )
|
|
{
|
|
ULONG ulBase = s_privateStackCnt;
|
|
PHB_DYNS pDynVar;
|
|
|
|
HB_TRACE(HB_TR_DEBUG, ("hb_memvarReleaseWithMask(%s, %d)", szMask, (int) bInclude));
|
|
|
|
while( ulBase > s_privateStackBase )
|
|
{
|
|
--ulBase;
|
|
pDynVar = s_privateStack[ ulBase ];
|
|
/* reset current value to NIL - the overriden variables will be
|
|
* visible after exit from current procedure
|
|
*/
|
|
if( pDynVar->hMemvar )
|
|
{
|
|
if( bInclude )
|
|
{
|
|
if( ( szMask[ 0 ] == '*') || hb_strMatchRegExp( pDynVar->pSymbol->szName, szMask ) )
|
|
hb_itemClear( s_globalTable[ pDynVar->hMemvar ].pVarItem );
|
|
}
|
|
else if( ! hb_strMatchRegExp( pDynVar->pSymbol->szName, szMask ) )
|
|
hb_itemClear( s_globalTable[ pDynVar->hMemvar ].pVarItem );
|
|
}
|
|
}
|
|
}
|
|
|
|
/* Checks if passed dynamic symbol is a variable and returns its scope
|
|
*/
|
|
static int hb_memvarScopeGet( PHB_DYNS pDynVar )
|
|
{
|
|
HB_TRACE(HB_TR_DEBUG, ("hb_memvarScopeGet(%p)", pDynVar));
|
|
|
|
if( pDynVar->hMemvar == 0 )
|
|
return HB_MV_UNKNOWN;
|
|
else
|
|
{
|
|
ULONG ulBase = s_privateStackCnt; /* start from the top of the stack */
|
|
int iMemvar = HB_MV_PUBLIC;
|
|
|
|
while( ulBase )
|
|
{
|
|
--ulBase;
|
|
if( pDynVar == s_privateStack[ ulBase ] )
|
|
{
|
|
if( ulBase >= s_privateStackBase )
|
|
iMemvar = HB_MV_PRIVATE_LOCAL;
|
|
else
|
|
iMemvar = HB_MV_PRIVATE_GLOBAL;
|
|
ulBase = 0;
|
|
}
|
|
}
|
|
return iMemvar;
|
|
}
|
|
}
|
|
|
|
/* This function checks the scope of passed variable name
|
|
*/
|
|
int hb_memvarScope( char * szVarName, ULONG ulLength )
|
|
{
|
|
int iMemvar = HB_MV_ERROR;
|
|
char * szName;
|
|
|
|
HB_TRACE(HB_TR_DEBUG, ("hb_memvarScope(%s, %lu)", szVarName, ulLength));
|
|
|
|
szName = ( char * ) hb_xalloc( ulLength );
|
|
if( szName )
|
|
{
|
|
PHB_DYNS pDynVar;
|
|
|
|
memcpy( szName, szVarName, ulLength );
|
|
pDynVar = hb_dynsymFind( hb_strUpper( szName, ulLength - 1 ) );
|
|
if( pDynVar )
|
|
iMemvar = hb_memvarScopeGet( pDynVar );
|
|
else
|
|
iMemvar = HB_MV_NOT_FOUND;
|
|
hb_xfree( szName );
|
|
}
|
|
|
|
return iMemvar;
|
|
}
|
|
|
|
/* Releases memory occupied by a variable
|
|
*/
|
|
static HB_DYNS_FUNC( hb_memvarClear )
|
|
{
|
|
HB_SYMBOL_UNUSED( Cargo );
|
|
|
|
if( pDynSymbol->hMemvar )
|
|
{
|
|
s_globalTable[ pDynSymbol->hMemvar ].counter = 1;
|
|
hb_memvarValueDecRef( pDynSymbol->hMemvar );
|
|
pDynSymbol->hMemvar = 0;
|
|
}
|
|
|
|
return TRUE;
|
|
}
|
|
|
|
/* Checks passed dynamic symbol if it is a PUBLIC variable and
|
|
* increments the counter eventually
|
|
*/
|
|
static HB_DYNS_FUNC( hb_memvarCountPublics )
|
|
{
|
|
if( hb_memvarScopeGet( pDynSymbol ) == HB_MV_PUBLIC )
|
|
( * ( ( int * )Cargo ) )++;
|
|
|
|
return TRUE;
|
|
}
|
|
|
|
/* Checks passed dynamic symbol if it is a PUBLIC variable and
|
|
* released it eventually stoping the searching
|
|
*/
|
|
static HB_DYNS_FUNC( hb_memvarClearPublic )
|
|
{
|
|
if( hb_memvarScopeGet( pDynSymbol ) == HB_MV_PUBLIC &&
|
|
hb_stricmp( pDynSymbol->pSymbol->szName, (char *) Cargo ) == 0 )
|
|
{
|
|
s_globalTable[ pDynSymbol->hMemvar ].counter = 1;
|
|
hb_memvarValueDecRef( pDynSymbol->hMemvar );
|
|
pDynSymbol->hMemvar = 0;
|
|
return FALSE;
|
|
}
|
|
|
|
return TRUE;
|
|
}
|
|
|
|
/* find and release if exists given public variable
|
|
*/
|
|
static void hb_memvarReleasePublic( PHB_ITEM pMemVar )
|
|
{
|
|
char *sPublic = pMemVar->item.asString.value;
|
|
|
|
HB_TRACE(HB_TR_DEBUG, ("hb_memvarReleasePublic(%p)", pMemVar ));
|
|
|
|
hb_dynsymEval( hb_memvarClearPublic, ( void * ) sPublic );
|
|
}
|
|
|
|
/* Count the number of variables with given scope
|
|
*/
|
|
static int hb_memvarCount( int iScope )
|
|
{
|
|
HB_TRACE(HB_TR_DEBUG, ("hb_memvarCount(%d)", iScope));
|
|
|
|
if( iScope == HB_MV_PUBLIC )
|
|
{
|
|
int iPublicCnt = 0;
|
|
|
|
hb_dynsymEval( hb_memvarCountPublics, ( void * ) &iPublicCnt );
|
|
return iPublicCnt;
|
|
}
|
|
else
|
|
return s_privateStackCnt; /* number of PRIVATE variables */
|
|
}
|
|
|
|
/* Checks passed dynamic symbol if it is a PUBLIC variable and returns
|
|
* a pointer to its dynamic symbol
|
|
*/
|
|
static HB_DYNS_FUNC( hb_memvarFindPublicByPos )
|
|
{
|
|
BOOL bCont = TRUE;
|
|
|
|
if( hb_memvarScopeGet( pDynSymbol ) == HB_MV_PUBLIC )
|
|
{
|
|
struct mv_PUBLIC_var_info *pStruPub = (struct mv_PUBLIC_var_info *) Cargo;
|
|
if( pStruPub->iPos-- == 0 )
|
|
{
|
|
pStruPub->bFound = TRUE;
|
|
pStruPub->pDynSym = pDynSymbol;
|
|
bCont =FALSE;
|
|
}
|
|
}
|
|
|
|
return bCont;
|
|
}
|
|
|
|
/* Returns the pointer to item that holds a value of variable (or NULL if
|
|
* not found). It fills also the pointer to the variable name
|
|
* Both pointers points to existing and used data - they shouldn't be
|
|
* deallocated.
|
|
*/
|
|
static HB_ITEM_PTR hb_memvarDebugVariable( int iScope, int iPos, char * *pszName )
|
|
{
|
|
HB_ITEM_PTR pValue = NULL;
|
|
*pszName = NULL;
|
|
|
|
HB_TRACE(HB_TR_DEBUG, ("hb_memvarDebugVariable(%d, %d, %p)", iScope, iPos, pszName));
|
|
|
|
if( iPos > 0 )
|
|
{
|
|
--iPos;
|
|
if( iScope == HB_MV_PUBLIC )
|
|
{
|
|
struct mv_PUBLIC_var_info struPub;
|
|
|
|
struPub.iPos = iPos;
|
|
struPub.bFound = FALSE;
|
|
/* enumerate existing dynamic symbols and fill this structure
|
|
* with info for requested PUBLIC variable
|
|
*/
|
|
hb_dynsymEval( hb_memvarFindPublicByPos, ( void * ) &struPub );
|
|
if( struPub.bFound )
|
|
{
|
|
pValue =s_globalTable[ struPub.pDynSym->hMemvar ].pVarItem;
|
|
*pszName =struPub.pDynSym->pSymbol->szName;
|
|
}
|
|
}
|
|
else
|
|
{
|
|
if( ( ULONG ) iPos < s_privateStackCnt )
|
|
{
|
|
HB_DYNS_PTR pDynSym = s_privateStack[ iPos ];
|
|
|
|
pValue =s_globalTable[ pDynSym->hMemvar ].pVarItem;
|
|
*pszName = pDynSym->pSymbol->szName;
|
|
}
|
|
}
|
|
}
|
|
|
|
return pValue;
|
|
}
|
|
|
|
static HB_DYNS_PTR hb_memvarFindSymbol( HB_ITEM_PTR pName )
|
|
{
|
|
HB_DYNS_PTR pDynSym = NULL;
|
|
|
|
HB_TRACE(HB_TR_DEBUG, ("hb_memvarFindSymbol(%p)", pName));
|
|
|
|
if( pName )
|
|
{
|
|
ULONG ulLen = pName->item.asString.length;
|
|
|
|
if( ulLen )
|
|
{
|
|
char * szName = ( char * ) hb_xgrab( ulLen + 1 );
|
|
char * szArg = pName->item.asString.value;
|
|
|
|
szName[ ulLen ] = '\0';
|
|
do
|
|
{
|
|
--ulLen;
|
|
szName[ ulLen ] = toupper( szArg[ ulLen ] );
|
|
} while( ulLen );
|
|
|
|
pDynSym = hb_dynsymFind( szName );
|
|
hb_xfree( szName );
|
|
}
|
|
}
|
|
return pDynSym;
|
|
}
|
|
|
|
/* ************************************************************************** */
|
|
|
|
HB_FUNC( __MVPUBLIC )
|
|
{
|
|
int iCount = hb_pcount();
|
|
|
|
if( iCount )
|
|
{
|
|
int i;
|
|
|
|
for( i = 1; i <= iCount; i++ )
|
|
{
|
|
PHB_ITEM pMemvar = hb_param( i, HB_IT_ANY );
|
|
|
|
if( pMemvar )
|
|
{
|
|
if( HB_IS_ARRAY( pMemvar ) )
|
|
{
|
|
/* we are accepting an one-dimensional array of strings only
|
|
*/
|
|
ULONG j, ulLen = hb_arrayLen( pMemvar );
|
|
HB_ITEM VarItem;
|
|
|
|
hb_itemInit( &VarItem );
|
|
for( j = 1; j <= ulLen; j++ )
|
|
{
|
|
hb_arrayGet( pMemvar, j, &VarItem );
|
|
hb_memvarCreateFromItem( &VarItem, VS_PUBLIC, NULL );
|
|
hb_itemClear( &VarItem );
|
|
}
|
|
}
|
|
else
|
|
hb_memvarCreateFromItem( pMemvar, VS_PUBLIC, NULL );
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
HB_FUNC( __MVPRIVATE )
|
|
{
|
|
int iCount = hb_pcount();
|
|
|
|
if( iCount )
|
|
{
|
|
int i;
|
|
|
|
for( i = 1; i <= iCount; i++ )
|
|
{
|
|
PHB_ITEM pMemvar = hb_param( i, HB_IT_ANY );
|
|
|
|
if( pMemvar )
|
|
{
|
|
if( HB_IS_ARRAY( pMemvar ) )
|
|
{
|
|
/* we are accepting an one-dimensional array of strings only
|
|
*/
|
|
ULONG j, ulLen = hb_arrayLen( pMemvar );
|
|
HB_ITEM VarItem;
|
|
|
|
hb_itemInit( &VarItem );
|
|
for( j = 1; j <= ulLen; j++ )
|
|
{
|
|
hb_arrayGet( pMemvar, j, &VarItem );
|
|
hb_memvarCreateFromItem( &VarItem, VS_PRIVATE, NULL );
|
|
hb_itemClear( &VarItem );
|
|
}
|
|
}
|
|
else
|
|
hb_memvarCreateFromItem( pMemvar, VS_PRIVATE, NULL );
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
HB_FUNC( __MVXRELEASE )
|
|
{
|
|
int iCount = hb_pcount();
|
|
|
|
if( iCount )
|
|
{
|
|
int i;
|
|
|
|
for( i = 1; i <= iCount; i++ )
|
|
{
|
|
PHB_ITEM pMemvar = hb_param( i, HB_IT_ANY );
|
|
|
|
if( pMemvar )
|
|
{
|
|
if( HB_IS_ARRAY( pMemvar ) )
|
|
{
|
|
/* we are accepting an one-dimensional array of strings only
|
|
*/
|
|
ULONG j, ulLen = hb_arrayLen( pMemvar );
|
|
HB_ITEM VarItem;
|
|
|
|
hb_itemInit( &VarItem );
|
|
for( j = 1; j <= ulLen; j++ )
|
|
{
|
|
hb_arrayGet( pMemvar, j, &VarItem );
|
|
hb_memvarRelease( &VarItem );
|
|
hb_itemClear( &VarItem );
|
|
}
|
|
}
|
|
else
|
|
hb_memvarRelease( pMemvar );
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
HB_FUNC( __MVRELEASE )
|
|
{
|
|
int iCount = hb_pcount();
|
|
|
|
if( iCount )
|
|
{
|
|
PHB_ITEM pMask = hb_param( 1, HB_IT_STRING );
|
|
|
|
if( pMask )
|
|
{
|
|
BOOL bIncludeVar;
|
|
|
|
if( iCount > 1 )
|
|
bIncludeVar = hb_parl( 2 );
|
|
else
|
|
bIncludeVar = TRUE;
|
|
|
|
if( pMask->item.asString.value[ 0 ] == '*' )
|
|
bIncludeVar = TRUE; /* delete all memvar variables */
|
|
hb_memvarReleaseWithMask( pMask->item.asString.value, bIncludeVar );
|
|
}
|
|
}
|
|
}
|
|
|
|
HB_FUNC( __MVSCOPE )
|
|
{
|
|
int iMemvar = HB_MV_ERROR;
|
|
|
|
if( hb_pcount() )
|
|
{
|
|
PHB_ITEM pVarName = hb_param( 1, HB_IT_STRING );
|
|
|
|
if( pVarName )
|
|
iMemvar = hb_memvarScope( pVarName->item.asString.value, pVarName->item.asString.length + 1 );
|
|
}
|
|
|
|
hb_retni( iMemvar );
|
|
}
|
|
|
|
HB_FUNC( __MVCLEAR )
|
|
{
|
|
hb_dynsymEval( hb_memvarClear, NULL );
|
|
}
|
|
|
|
HB_FUNC( __MVDBGINFO )
|
|
{
|
|
int iCount = hb_pcount();
|
|
|
|
if( iCount == 1 ) /* request for a number of variables */
|
|
hb_retni( hb_memvarCount( hb_parni( 1 ) ) );
|
|
|
|
else if( iCount >= 2 ) /* request for a value of variable */
|
|
{
|
|
HB_ITEM_PTR pValue;
|
|
char * szName;
|
|
|
|
pValue = hb_memvarDebugVariable( hb_parni( 1 ), hb_parni( 2 ), &szName );
|
|
|
|
if( pValue )
|
|
{
|
|
/*the requested variable was found
|
|
*/
|
|
if( iCount >= 3 && ISBYREF( 3 ) )
|
|
{
|
|
/* we have to use this variable regardless of its current value
|
|
*/
|
|
HB_ITEM_PTR pName = hb_param( 3, HB_IT_ANY );
|
|
|
|
hb_itemPutC( pName, szName ); /* clear an old value and copy a new one */
|
|
/* szName points directly to a symbol name - it cannot be released
|
|
*/
|
|
}
|
|
hb_itemReturn( pValue );
|
|
/* pValue points directly to the item structure used by this variable
|
|
* this item cannot be released
|
|
*/
|
|
}
|
|
else
|
|
{
|
|
hb_ret(); /* return NIL value */
|
|
|
|
if( iCount >= 3 && ISBYREF( 3 ) )
|
|
{
|
|
/* we have to use this variable regardless of its current value
|
|
*/
|
|
HB_ITEM_PTR pName = hb_param( 3, HB_IT_ANY );
|
|
|
|
hb_itemPutC( pName, "?" ); /* clear an old value and copy a new one */
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
HB_FUNC( __MVEXIST )
|
|
{
|
|
HB_ITEM_PTR pName = hb_param( 1, HB_IT_STRING );
|
|
PHB_DYNS pDyn;
|
|
|
|
hb_retl( pName && ( pDyn = hb_memvarFindSymbol( pName ) ) != NULL && pDyn->hMemvar );
|
|
}
|
|
|
|
HB_FUNC( __MVGET )
|
|
{
|
|
HB_ITEM_PTR pName = hb_param( 1, HB_IT_STRING );
|
|
|
|
if( pName )
|
|
{
|
|
HB_DYNS_PTR pDynVar = hb_memvarFindSymbol( pName );
|
|
|
|
if( pDynVar )
|
|
{
|
|
HB_ITEM retValue;
|
|
|
|
hb_itemInit( &retValue );
|
|
hb_memvarGetValue( &retValue, pDynVar->pSymbol );
|
|
hb_itemClear( hb_itemReturn( &retValue ) );
|
|
}
|
|
else
|
|
{
|
|
/* Generate an error with retry possibility
|
|
* (user created error handler can create this variable)
|
|
*/
|
|
USHORT uiAction = E_RETRY;
|
|
HB_ITEM_PTR pError;
|
|
|
|
pError = hb_errRT_New( ES_ERROR, NULL, EG_NOVAR, 1003,
|
|
NULL, pName->item.asString.value, 0, EF_CANRETRY );
|
|
|
|
while( uiAction == E_RETRY )
|
|
{
|
|
uiAction = hb_errLaunch( pError );
|
|
if( uiAction == E_RETRY )
|
|
{
|
|
pDynVar = hb_memvarFindSymbol( pName );
|
|
if( pDynVar )
|
|
{
|
|
HB_ITEM retValue;
|
|
|
|
hb_itemInit( &retValue );
|
|
hb_memvarGetValue( &retValue, pDynVar->pSymbol );
|
|
hb_itemClear( hb_itemReturn( &retValue ) );
|
|
uiAction = E_DEFAULT;
|
|
}
|
|
}
|
|
}
|
|
hb_errRelease( pError );
|
|
}
|
|
}
|
|
else
|
|
{
|
|
/* either the first parameter is not specified or it has a wrong type
|
|
* (it must be a string)
|
|
* This is not a critical error - we can continue normal processing
|
|
*/
|
|
/* TODO: This should be expanded a little to report a passed incorrect
|
|
* value to the error handler
|
|
*/
|
|
hb_errRT_BASE_SubstR( EG_ARG, 3009, NULL, NULL, 1, hb_paramError( 1 ) );
|
|
}
|
|
}
|
|
|
|
HB_FUNC( __MVPUT )
|
|
{
|
|
HB_ITEM_PTR pName = hb_param( 1, HB_IT_STRING );
|
|
HB_ITEM nil;
|
|
HB_ITEM_PTR pValue = &nil;
|
|
|
|
nil.type = HB_IT_NIL;
|
|
if( hb_pcount() >= 2 )
|
|
pValue = hb_param( 2, HB_IT_ANY );
|
|
|
|
if( pName )
|
|
{
|
|
/* the first parameter is a string with not empty variable name
|
|
*/
|
|
HB_DYNS_PTR pDynVar = hb_memvarFindSymbol( pName );
|
|
|
|
if( pDynVar )
|
|
{
|
|
/* variable was declared somwhere - assign a new value
|
|
*/
|
|
hb_memvarSetValue( pDynVar->pSymbol, pValue );
|
|
}
|
|
else
|
|
{
|
|
/* attempt to assign a value to undeclared variable
|
|
* create the PRIVATE one
|
|
*/
|
|
hb_memvarCreateFromDynSymbol( hb_dynsymGet( pName->item.asString.value ), VS_PRIVATE, pValue );
|
|
}
|
|
hb_itemReturn( pValue );
|
|
}
|
|
else
|
|
{
|
|
/* either the first parameter is not specified or it has a wrong type
|
|
* (it must be a string)
|
|
* This is not a critical error - we can continue normal processing
|
|
*/
|
|
/* TODO: This should be expanded a little to report a passed incorrect
|
|
* value to the error handler
|
|
*/
|
|
HB_ITEM_PTR pRetValue = hb_errRT_BASE_Subst( EG_ARG, 3010, NULL, NULL, 1, hb_paramError( 1 ) );
|
|
|
|
if( pRetValue )
|
|
hb_itemRelease( pRetValue );
|
|
hb_itemReturn( pValue );
|
|
}
|
|
}
|
|
|
|
#define HB_MEM_REC_LEN 32
|
|
#define HB_MEM_NUM_LEN 8
|
|
|
|
typedef struct
|
|
{
|
|
char * pszMask;
|
|
BOOL bIncludeMask;
|
|
BYTE * buffer;
|
|
FHANDLE fhnd;
|
|
} MEMVARSAVE_CARGO;
|
|
|
|
/* saves a variable to a mem file already open */
|
|
|
|
static HB_DYNS_FUNC( hb_memvarSave )
|
|
{
|
|
char * pszMask = ( ( MEMVARSAVE_CARGO * ) Cargo )->pszMask;
|
|
BOOL bIncludeMask = ( ( MEMVARSAVE_CARGO * ) Cargo )->bIncludeMask;
|
|
BYTE * buffer = ( ( MEMVARSAVE_CARGO * ) Cargo )->buffer;
|
|
FHANDLE fhnd = ( ( MEMVARSAVE_CARGO * ) Cargo )->fhnd;
|
|
|
|
/* NOTE: Harbour name lengths are not limited, but the .MEM file
|
|
structure is not flexible enough to allow for it.
|
|
[vszakats] */
|
|
|
|
if( pDynSymbol->hMemvar )
|
|
{
|
|
BOOL bMatch = ( pszMask[ 0 ] == '*' || hb_strMatchRegExp( pDynSymbol->pSymbol->szName, pszMask ) );
|
|
|
|
PHB_ITEM pItem = s_globalTable[ pDynSymbol->hMemvar ].pVarItem;
|
|
|
|
/* Process it if it matches the passed mask */
|
|
if( bIncludeMask ? bMatch : ! bMatch )
|
|
{
|
|
/* NOTE: Clipper will not initialize the record buffer with
|
|
zeros, so they will look trashed. [vszakats] */
|
|
memset( buffer, 0, HB_MEM_REC_LEN );
|
|
|
|
/* NOTE: Save only the first 10 characters of the name */
|
|
strncpy( ( char * ) buffer, pDynSymbol->pSymbol->szName, 10 );
|
|
buffer[ 10 ] = '\0';
|
|
|
|
if( HB_IS_STRING( pItem ) && ( hb_itemGetCLen( pItem ) + 1 ) <= SHRT_MAX )
|
|
{
|
|
/* Store the closing zero byte, too */
|
|
USHORT uiLength = ( USHORT ) ( hb_itemGetCLen( pItem ) + 1 );
|
|
|
|
buffer[ 11 ] = 'C' + 128;
|
|
buffer[ 16 ] = HB_LOBYTE( uiLength );
|
|
buffer[ 17 ] = HB_HIBYTE( uiLength );
|
|
|
|
hb_fsWrite( fhnd, buffer, HB_MEM_REC_LEN );
|
|
hb_fsWrite( fhnd, ( BYTE * ) hb_itemGetCPtr( pItem ), uiLength );
|
|
}
|
|
else if( HB_IS_NUMERIC( pItem ) )
|
|
{
|
|
BYTE byNum[ sizeof( double ) ];
|
|
int iWidth;
|
|
int iDec;
|
|
|
|
hb_itemGetNLen( pItem, &iWidth, &iDec );
|
|
|
|
buffer[ 11 ] = 'N' + 128;
|
|
#ifdef HB_C52_STRICT
|
|
/* NOTE: This is the buggy, but fully CA-Cl*pper compatible method. [vszakats] */
|
|
buffer[ 16 ] = ( BYTE ) iWidth + ( HB_IS_DOUBLE( pItem ) ? iDec + 1 : 0 );
|
|
#else
|
|
/* NOTE: This would be the correct method, but Clipper is buggy here. [vszakats] */
|
|
buffer[ 16 ] = ( BYTE ) iWidth + ( iDec == 0 ? 0 : iDec + 1 );
|
|
#endif
|
|
buffer[ 17 ] = ( BYTE ) iDec;
|
|
|
|
HB_PUT_LE_DOUBLE( byNum, hb_itemGetND( pItem ) );
|
|
|
|
hb_fsWrite( fhnd, buffer, HB_MEM_REC_LEN );
|
|
hb_fsWrite( fhnd, byNum, sizeof( byNum ) );
|
|
}
|
|
else if( HB_IS_DATE( pItem ) )
|
|
{
|
|
BYTE byNum[ sizeof( double ) ];
|
|
double dNumber = ( double ) hb_itemGetDL( pItem );
|
|
|
|
buffer[ 11 ] = 'D' + 128;
|
|
buffer[ 16 ] = 1;
|
|
buffer[ 17 ] = 0;
|
|
|
|
HB_PUT_LE_DOUBLE( byNum, dNumber );
|
|
|
|
hb_fsWrite( fhnd, buffer, HB_MEM_REC_LEN );
|
|
hb_fsWrite( fhnd, byNum, sizeof( byNum ) );
|
|
}
|
|
else if( HB_IS_LOGICAL( pItem ) )
|
|
{
|
|
BYTE byLogical[ 1 ];
|
|
|
|
buffer[ 11 ] = 'L' + 128;
|
|
buffer[ 16 ] = sizeof( BYTE );
|
|
buffer[ 17 ] = 0;
|
|
|
|
byLogical[ 0 ] = hb_itemGetL( pItem ) ? 1 : 0;
|
|
|
|
hb_fsWrite( fhnd, buffer, HB_MEM_REC_LEN );
|
|
hb_fsWrite( fhnd, byLogical, sizeof( BYTE ) );
|
|
}
|
|
}
|
|
}
|
|
return TRUE;
|
|
}
|
|
|
|
HB_FUNC( __MVSAVE )
|
|
{
|
|
/* Clipper also checks for the number of arguments here */
|
|
if( hb_pcount() == 3 && ISCHAR( 1 ) && ISCHAR( 2 ) && ISLOG( 3 ) )
|
|
{
|
|
PHB_FNAME pFileName;
|
|
char szFileName[ _POSIX_PATH_MAX + 1 ];
|
|
FHANDLE fhnd;
|
|
|
|
/* Generate filename */
|
|
|
|
pFileName = hb_fsFNameSplit( hb_parc( 1 ) );
|
|
|
|
if( pFileName->szExtension == NULL )
|
|
pFileName->szExtension = ".mem";
|
|
|
|
if( pFileName->szPath == NULL )
|
|
pFileName->szPath = hb_set.HB_SET_DEFAULT;
|
|
|
|
hb_fsFNameMerge( szFileName, pFileName );
|
|
hb_xfree( pFileName );
|
|
|
|
/* Create .MEM file */
|
|
|
|
while( ( fhnd = hb_fsCreate( ( BYTE * ) szFileName, FC_NORMAL ) ) == FS_ERROR )
|
|
{
|
|
USHORT uiAction = hb_errRT_BASE_Ext1( EG_CREATE, 2006, NULL, szFileName, hb_fsError(), EF_CANDEFAULT | EF_CANRETRY, 3, hb_paramError( 1 ), hb_paramError( 2 ), hb_paramError( 3 ) );
|
|
|
|
if( uiAction == E_DEFAULT || uiAction == E_BREAK )
|
|
break;
|
|
}
|
|
|
|
if( fhnd != FS_ERROR )
|
|
{
|
|
BYTE buffer[ HB_MEM_REC_LEN ];
|
|
MEMVARSAVE_CARGO msc;
|
|
|
|
msc.pszMask = hb_parc( 2 );
|
|
msc.bIncludeMask = hb_parl( 3 );
|
|
msc.buffer = buffer;
|
|
msc.fhnd = fhnd;
|
|
|
|
/* Walk through all visible memory variables and save each one */
|
|
|
|
hb_dynsymEval( hb_memvarSave, ( void * ) &msc );
|
|
|
|
buffer[ 0 ] = '\x1A';
|
|
hb_fsWrite( fhnd, buffer, 1 );
|
|
|
|
hb_fsClose( fhnd );
|
|
}
|
|
}
|
|
else
|
|
/* NOTE: Undocumented error message in CA-Cl*pper 5.2e and 5.3x. [ckedem] */
|
|
hb_errRT_BASE( EG_ARG, 2008, NULL, "__MSAVE", HB_MIN( hb_pcount(), 3 ), hb_paramError( 1 ), hb_paramError( 2 ), hb_paramError( 3 ) );
|
|
}
|
|
|
|
/* NOTE: There's an extension in Harbour, which makes it possible to only
|
|
load (or not load) variable names with a specific name mask.
|
|
[vszakats] */
|
|
|
|
HB_FUNC( __MVRESTORE )
|
|
{
|
|
/* Clipper checks for the number of arguments here here, but we cannot
|
|
in Harbour since we have two optional parameters as an extension. */
|
|
if( ISCHAR( 1 ) && ISLOG( 2 ) )
|
|
{
|
|
PHB_FNAME pFileName;
|
|
char szFileName[ _POSIX_PATH_MAX + 1 ];
|
|
FHANDLE fhnd;
|
|
|
|
BOOL bAdditive = hb_parl( 2 );
|
|
|
|
/* Clear all memory variables if not ADDITIVE */
|
|
|
|
if( ! bAdditive )
|
|
hb_dynsymEval( hb_memvarClear, NULL );
|
|
|
|
/* Generate filename */
|
|
|
|
pFileName = hb_fsFNameSplit( hb_parc( 1 ) );
|
|
|
|
if( pFileName->szExtension == NULL )
|
|
pFileName->szExtension = ".mem";
|
|
|
|
if( pFileName->szPath == NULL )
|
|
pFileName->szPath = hb_set.HB_SET_DEFAULT;
|
|
|
|
hb_fsFNameMerge( szFileName, pFileName );
|
|
hb_xfree( pFileName );
|
|
|
|
/* Open .MEM file */
|
|
|
|
while( ( fhnd = hb_fsOpen( ( BYTE * ) szFileName, FO_READ | FO_DENYWRITE | FO_PRIVATE ) ) == FS_ERROR )
|
|
{
|
|
USHORT uiAction = hb_errRT_BASE_Ext1( EG_OPEN, 2005, NULL, szFileName, hb_fsError(), EF_CANDEFAULT | EF_CANRETRY, 2, hb_paramError( 1 ), hb_paramError( 2 ) );
|
|
|
|
if( uiAction == E_DEFAULT || uiAction == E_BREAK )
|
|
break;
|
|
}
|
|
|
|
if( fhnd != FS_ERROR )
|
|
{
|
|
char * pszMask = ISCHAR( 3 ) ? hb_parc( 3 ) : ( char * ) "*";
|
|
BOOL bIncludeMask = ISCHAR( 4 ) ? hb_parl( 4 ) : TRUE;
|
|
BYTE buffer[ HB_MEM_REC_LEN ];
|
|
|
|
while( hb_fsRead( fhnd, buffer, HB_MEM_REC_LEN ) == HB_MEM_REC_LEN )
|
|
{
|
|
PHB_ITEM pName = hb_itemPutC( NULL, ( char * ) buffer );
|
|
USHORT uiType = ( USHORT ) ( buffer[ 11 ] - 128 );
|
|
USHORT uiWidth = ( USHORT ) buffer[ 16 ];
|
|
USHORT uiDec = ( USHORT ) buffer[ 17 ];
|
|
PHB_ITEM pItem = NULL;
|
|
|
|
switch( uiType )
|
|
{
|
|
case 'C':
|
|
{
|
|
BYTE * pbyString;
|
|
|
|
uiWidth += uiDec * 256;
|
|
pbyString = ( BYTE * ) hb_xgrab( uiWidth );
|
|
|
|
if( hb_fsRead( fhnd, pbyString, uiWidth ) == uiWidth )
|
|
pItem = hb_itemPutCL( NULL, ( char * ) pbyString, uiWidth - 1 );
|
|
|
|
hb_xfree( pbyString );
|
|
|
|
break;
|
|
}
|
|
|
|
case 'N':
|
|
{
|
|
BYTE pbyNumber[ HB_MEM_NUM_LEN ];
|
|
|
|
if( hb_fsRead( fhnd, pbyNumber, HB_MEM_NUM_LEN ) == HB_MEM_NUM_LEN )
|
|
pItem = hb_itemPutNLen( NULL, HB_GET_LE_DOUBLE( pbyNumber ), uiWidth - ( uiDec ? ( uiDec + 1 ) : 0 ), uiDec );
|
|
|
|
break;
|
|
}
|
|
|
|
case 'D':
|
|
{
|
|
BYTE pbyNumber[ HB_MEM_NUM_LEN ];
|
|
|
|
if( hb_fsRead( fhnd, pbyNumber, HB_MEM_NUM_LEN ) == HB_MEM_NUM_LEN )
|
|
pItem = hb_itemPutDL( NULL, ( long ) HB_GET_LE_DOUBLE( pbyNumber ) );
|
|
|
|
break;
|
|
}
|
|
|
|
case 'L':
|
|
{
|
|
BYTE pbyLogical[ 1 ];
|
|
|
|
if( hb_fsRead( fhnd, pbyLogical, 1 ) == 1 )
|
|
pItem = hb_itemPutL( NULL, pbyLogical[ 0 ] != 0 );
|
|
|
|
break;
|
|
}
|
|
}
|
|
|
|
if( pItem )
|
|
{
|
|
BOOL bMatch = ( pszMask[ 0 ] == '*' || hb_strMatchRegExp( hb_itemGetCPtr( pName ), pszMask ) );
|
|
|
|
/* Process it if it matches the passed mask */
|
|
if( bIncludeMask ? bMatch : ! bMatch )
|
|
{
|
|
/* the first parameter is a string with not empty variable name */
|
|
HB_DYNS_PTR pDynVar = hb_memvarFindSymbol( pName );
|
|
|
|
if( pDynVar )
|
|
/* variable was declared somwhere - assign a new value */
|
|
hb_memvarSetValue( pDynVar->pSymbol, pItem );
|
|
else
|
|
/* attempt to assign a value to undeclared variable create the PRIVATE one */
|
|
hb_memvarCreateFromDynSymbol( hb_dynsymGet( pName->item.asString.value ), VS_PRIVATE, pItem );
|
|
|
|
hb_itemReturn( pItem );
|
|
}
|
|
|
|
hb_itemRelease( pItem );
|
|
}
|
|
|
|
hb_itemRelease( pName );
|
|
}
|
|
|
|
hb_fsClose( fhnd );
|
|
}
|
|
else
|
|
hb_retl( FALSE );
|
|
}
|
|
else
|
|
/* NOTE: Undocumented error message in CA-Cl*pper 5.2e and 5.3x. [ckedem] */
|
|
hb_errRT_BASE( EG_ARG, 2007, NULL, "__MRESTORE", HB_MIN( hb_pcount(), 2 ), hb_paramError( 1 ), hb_paramError( 2 ) );
|
|
}
|
|
|
|
/* ----------------------------------------------------------------------- */
|
|
/* The garbage collector interface */
|
|
/* ----------------------------------------------------------------------- */
|
|
|
|
|
|
/* Mark all memvars as used so they will not be released by the
|
|
* garbage collector
|
|
*/
|
|
void hb_memvarsIsMemvarRef( void )
|
|
{
|
|
HB_TRACE(HB_TR_DEBUG, ("hb_memvarsIsMemvarRef()"));
|
|
|
|
if( s_globalTable )
|
|
{
|
|
ULONG ulCnt = s_globalLastFree;
|
|
|
|
while( --ulCnt )
|
|
{
|
|
/* do not check detached variables - for these variables only
|
|
* references from the eval stack are meaningfull for the GC
|
|
*/
|
|
if( s_globalTable[ ulCnt ].counter && s_globalTable[ ulCnt ].hPrevMemvar != ( HB_HANDLE )-1 )
|
|
{
|
|
if( HB_IS_GCITEM( s_globalTable[ ulCnt ].pVarItem ) )
|
|
hb_gcItemRef( s_globalTable[ ulCnt ].pVarItem );
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
HB_HANDLE hb_memvarGetVarHandle( char *szName )
|
|
{
|
|
PHB_DYNS pDyn;
|
|
|
|
if( ( pDyn = hb_dynsymFind( szName ) ) != NULL )
|
|
return pDyn->hMemvar;
|
|
else
|
|
return 0; /* invalid handle */
|
|
}
|
|
|
|
PHB_ITEM hb_memvarGetValueByHandle( HB_HANDLE hMemvar )
|
|
{
|
|
if( hMemvar && hMemvar < s_globalTableSize )
|
|
return s_globalTable[ hMemvar ].pVarItem;
|
|
else
|
|
return NULL;
|
|
}
|