fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
8bc1e2f652d00a5b85ee13ca90a4d073abf66243
harbour-core/harbour/source/vm/memvars.c
Przemyslaw Czerpak 68ceb7444c 2006-03-22 16:05 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl) 
* harbour/include/hbstack.h
  * harbour/source/vm/estack.c
    + added hb_stackDecrease( ULONG )

  * harbour/include/hbxvm.h
  * harbour/source/vm/hvm.c
    + added hb_xvmArrayItemPush(), hb_xvmArrayItemPop(), hb_xvmMultByInt()

  * harbour/source/compiler/gencc.c
    % use hb_xvmArrayItemPush(), hb_xvmArrayItemPop(), hb_xvmMultByInt()
      If someone has time then it will be good to also add:
      hb_xvmDivByInt(), hb_xvmModulusInt(), hb_xvmPlusInt(), hb_xvmMinusInt()

  * harbour/source/vm/itemapi.c
    * use simple memcpy() in hb_itemSwap() - it's save in current HVM
      It could become unsafe if we add reference tracing or sth like
      that in the future but in such case we will have to also update
      hb_itemCopy() and hb_itemMove() so we can also update hb_itemSwap()

  * harbour/source/vm/asort.c
  * harbour/source/vm/classes.c
  * harbour/source/vm/memvars.c
  * harbour/source/vm/hvm.c
    * cleaned the code which created HB_ITEMs on C stack. Only three
      places have to be update yet and array/clodeblock creation little
      bit modified and we will be able add automatic GC activation in
      hb_xgrab() or hb_gcAlloc().
2006-03-22 15:14:21 +00:00

1654 lines
48 KiB
C
Raw Blame History

/*
* $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( char *, ULONG );
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_DYNS_PTR pDynVar;
char * szValue = NULL;
HB_TRACE(HB_TR_DEBUG, ("hb_memvarGetStrValuePtr(%s, %li)", szVarName, pulLen));
pDynVar = hb_memvarFindSymbol( szVarName, *pulLen );
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( char * szArg, ULONG ulLen )
{
HB_DYNS_PTR pDynSym = NULL;
HB_TRACE(HB_TR_DEBUG, ("hb_memvarFindSymbol(%p,%lu)", szArg, ulLen));
if( szArg && *szArg && ulLen )
{
char * szName = ( char * ) hb_xgrab( ulLen + 1 );
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 );
for( j = 1; j <= ulLen; j++ )
{
hb_memvarCreateFromItem( hb_arrayGetItemPtr( pMemvar, j ), VS_PUBLIC, NULL );
}
}
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 );
for( j = 1; j <= ulLen; j++ )
{
hb_memvarCreateFromItem( hb_arrayGetItemPtr( pMemvar, j ), VS_PRIVATE, NULL );
}
}
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 );
for( j = 1; j <= ulLen; j++ )
{
hb_memvarRelease( hb_arrayGetItemPtr( pMemvar, j ) );
}
}
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 )
{
PHB_DYNS pDyn;
pDyn = hb_memvarFindSymbol( hb_parc( 1 ), hb_parclen( 1 ) );
hb_retl( pDyn && pDyn->hMemvar );
}
HB_FUNC( __MVGET )
{
HB_ITEM_PTR pName = hb_param( 1, HB_IT_STRING );
if( pName )
{
HB_DYNS_PTR pDynVar = hb_memvarFindSymbol( pName->item.asString.value,
pName->item.asString.length );
if( pDynVar )
{
PHB_ITEM pValue;
pValue = hb_stackTopItem();
hb_stackPush();
hb_memvarGetValue( pValue, pDynVar->pSymbol );
hb_itemReturnForward( pValue );
hb_stackDec();
}
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( hb_itemGetCPtr( pName ),
hb_itemGetCLen( pName ) );
if( pDynVar )
{
PHB_ITEM pValue;
pValue = hb_stackTopItem();
hb_stackPush();
hb_memvarGetValue( pValue, pDynVar->pSymbol );
hb_itemReturnForward( pValue );
hb_stackDec();
break;
}
}
}
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_PTR pValue = hb_paramError( 2 );
if( pName )
{
/* the first parameter is a string with not empty variable name
*/
HB_DYNS_PTR pDynVar = hb_memvarFindSymbol( pName->item.asString.value,
pName->item.asString.length );
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 )
{
char *szName = hb_strdup( ( 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( szName, 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( szName, strlen( szName ) );
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( szName ), VS_PRIVATE, pItem );
hb_itemReturn( pItem );
}
hb_itemRelease( pItem );
}
hb_xfree( szName );
}
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;
}
Reference in New Issue View Git Blame Copy Permalink